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FOREWORD 


The HP PASCAL source code contained in Section 1 was developed for the 
Mission Planning and Analysis Division (MPAD) of NASA/JSC, and takes the 
place of flow charts defining the specifications for a Utility Software Unit 
designed to support orbital flight simulators such as MANHANDLE and GREAS 
(General Research and Engineering Analysis Simulator). Besides providing 
basic input/output, mathematical, vector, matrix, quaternion, and statistical 
routines for such simulators, one of the primary functions of the Utility 
Softuare Unit is to isolate all system-dependent code in one well-defined 
compartment, thereby facilitating transportation of the simulations from one 
computer to another. 

Sections 1.1.1 and 1.1.2, respectively, contain directives to the PASCAL 
compilers of the HP-9000 Series 200 Pascal 3.0 operating system and the 

HP-9000 Series 500 HP-UX 5.0 operating system that produce in each system 

a single file of relocatable code from four separate files of source 

code. Three of the source code files < 1 Ut ilmath. I * , *Ut ilvemq. I ’ , and 
’Utilstat.I’ ) are common to both operating systems. The fourth source code 
file ( ’UTILSPIF. I * for the Pascal 3,0 system and ’utilspif.I’ for the HP-UX 
5.0 system) contains all of the system-dependent PASCAL code for the Utility 
Softuare Unit. A fifth file of source code written in the C language 
( ’utilscif . c’ , listed in Section 1.7) is required to interface ’utilspif.I’ 
with the HP-UX "curses" hardware- independent terminal input/output package, 
which uses "# define" statements extensively to define C pseudofunctions that 
cannot be called directly from a PASCAL routine. 

Section 2.1.1 contains the Pascal 3.0 compiler directives and the driver 
source code for a unit test program. Its counterpart for the HP-UX 5.0 
operating system is contained in Section 2.1.2. The major portion of the 
unit test program source code (Sections 2.2 through 2.G) is common to both 
operating systems. Unit test results from the Pascal 3.0 operating system 
are shoun in Section 3.1. The results from the HP-UX operating system are 
shown in Section 3.2, 

• 

Because its portability is limited to Hewlett-Packard computers, HP PASCAL 
(References 1 and Z) is not regarded as the best language for ultimate 
implementation of general purpose softuare. Houever, pending the availabil- 
ity of an ADA compiler for MPAD’s mainline computers, its unique features and 
versatility make it the best medium at hand for the development, testing, and 
maintenance of softuare specifications (which, as distinguished from execut- 
able code, is the primary subject of this document). The fact that interim 
or prototype executable programs can be implemented (on Hewlett-Packard 
computers) simply by compiling the source code that serves as the software 
specification is considered to be advantageous, but it was not the reason for 
choosing HP PASCAL as the medium for specification. 
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File ’UTILUNIT.TEXT’ Page 1 


Updated @ 23:04:37 Sat 27 Sep 1986 


< begin File ’UTILUNIT.TEXT’ > 

< Utility Softuare Unit for HP-9000 Model 216 uith Pascal 3.0 Op Sys > 

< NASA/ JSC/MP AD/TRW : San Wilson > 

< This construct binds several related PASCAL nodules into a single conpila- > 

< tion unit so that the relocatable code produced by the conpiler uill reside } 

< in one file rather than in nany, thus sinplifying input instructions to the } 

< operating systen’s linker/loader when conbining it uith other relocatable > 

< code to produce an executable progran. To sinplify editing, the source } 

< code for each functional nodule resides in a separate file, each being > 

< naned in an "include" directive to the conpiler (see belou). > 

< Except for the INVERT.MATRIX and 01 AGONAL I ZE_SYMMATRI X procedures in nodule } 

< UTILMATH, the input paraneters for every exported function and procedure > 

i defined in the Utility Softuare Unit are passed “by value" rather than } 

i. "by reference". This neans that the input values are assigned to local > 

< variables uithin the called routine, and that no reference to an input var- } 
i iable by the called routine can nodify anything other than the local copy. > 

< It also nakes it possible in the calling routine to substitute any expres- > 

{ sion of the proper type (even a naned or a literal constant) for any formal } 

< input parameter in the argument list of the called routine, thus often } 

< simplifying the code quite a bit. For instance, the single statement } 

< y 

< 0UTPUT_ANG :» ANGDEGt ATANZ< 1.5L0, D0TP< POS, ZUNVEC > > > s > 

< > 

■C uould have to be replaced by a sequence something like } 

< y 

< V :*> ZUNVEC i > 

< X D0TP( POS, V ) 5 } 

< Y 1.5L0 j > 

i A : - ATAN2( Y, X > s > 

i 0UTPUT_ANG :*■ ANGOEGt A ) ; } 

< y 

f if the inputs to ANGDEG, ATANZ, and DOTP uere passed by reference, because > 

< only a variable name is alloued to replace a formal parameter that is > 

< passed by reference. } 

$ Sysprog On $ 

$ Suitch_strpos $ 

$ Heap_dispose On $ 

$ include 'Utilindx.I. ' $ 

$ include ’Utilmath. I . ’ $ 

$ include ’ UTILSPIF. I . ’ $ 

$ include ’Utilvemq. I . ’ $ 

$ include ’ Utilstat . I . ’ $ 

module UTILDUMMY ; { no functions just terminates compilation tidily } 

export type SOMETHING. T0_SATISFY_C0MPILER = boolean s 

implement 

end . < File ’UTILUNIT.TEXT’ > 


¥5BB1 309 1 


1 . 1 . 1 - 1 




1 . 1 . 2 . 




Series 500 / HP-UX 5.0 Compiler Directives 


1 - 1 - Z— x 



File ’utilunit.p’ Page 1 Updated @ 23:05:00 Sat 27 Sep 1986 

< begin File 'utilunit.p' > 

< Utility Software Unit for HP-9000 Series 500 with HP-UX 5.0 Op Sys > 


< NASA/ JSC/MPAD/TRW : San Wilson } 


< This construct binds several related PASCAL nodules into a single conpila- > 
{ tion unit so that the relocatable code produced by the conpiler will reside > 

< in one file rather than in nany, thus sinplifying input instructions to the } 
{ operating systen's 1 inker/loader when conbining it with other relocatable } 

< code to produce an executable progran. To sinplify editing, the source > 

< code for each functional nodule resides in a separate file, each being > 

f naned in an "include" directive to the conpiler (see below). } 


< 

< 

< 

< 

i 

< 

< 

< 

< 

< 

< 

i 

{ 

< 

< 

< 

< 

< 

< 

{ 

< 

< 

< 


Except for the INVERT_MATRIX and DIAGONAL I ZE_SYMMATRIX procedures in nodule > 
UTILMATH, the input paraneters for every exported function and procedure } 
defined in the Utility Software Unit are passed “by value" rather than } 
“by reference". This neans that the input values are assigned to local > 
variables within the called routine, and that no reference to an input var- > 
iable by the called routine can modify anything other than the local copy. > 
It also makes it possible in the calling routine to substitute any expres- 1 
sion of the proper type (even a naned or a literal constant) for any formal > 


input parameter in the argument list of the called routine, thus often > 

sinplifying the code quite a bit. For instance, the single statement } 

} 

OUTPUT_ANG := ANGDEG< ATAN2( 1.5L0, DOTP( POS, ZUNVEC ) ) ) s } 

. > 

would have to be replaced by a sequence something like > 

} 

V :=■ ZUNVEC j > 

X :« DOTP( POS, V ) ; > 

Y :» 1.5L0 ; } 

A := ATAN2( Y, X ) ; } 

OUTPUT_ANG := ANGDEG( A ) ; } 

> 

if the inputs to ANGDEG, ATAN2, and DOTP were passed by reference, because > 
only a variable nane is allowed to replace a formal parameter that is > 

passed by reference. } 


$ standard_level , hp_modcal’ $ 
$ include ’Utilindx.I’ $ 
$ type_coercion ’ noncompatible ’ $ 

* include 'Utilmath.I' $ 

* type_coercion 'conversion’ $ 

* include 'utilspif.I' $ 
$ include ’Utilvemq.I’ $ 
$ include ’Utilstat.I’ $ 


module UTILOUMMY 5 { no function? just terminates compilation tidily } 

export type SOMETHI NG_T0_SATI SF Y_COMPI LER = boolean 5 

implement 

end . < File 'utilunit.p' > 
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File ’Utilindx.I’ Page 1 
$ page $ { begin File ’Utilindx.I’ > 


Updated @ 23:05:28 Sat Z7 Sep 1986 


< Utility Software Unit for HP-9000 Series Z00/300/500 Computers > 

< Comment File } < Subject : Index of Global Identifiers } 

< NASA/JSC/MPAD/TRU : Sam Wilson } 


i 


Identifier 

Declaration Parent 

Category Identifier 

Source 

Module 

ANG1 

function 

UTILMATH 

ANG2 

function 

UTILMATH 

ANGDEG 

function 

UTILMATH 

ANGRAD 

function 

UTILMATH 

ATAN1 

function 

UTILMATH 

ATANZ 

function 

UTILMATH 

C 

rec field : CHINPUTREC 

UTILSPIF 

CAPUORD 

function 

UTILSPIF 

CHAR.INPUT 

function 

UTILSPIF 

CHECHO 

type enum : CHECHOMODE 

UTILSPIF 

CHECHOMODE 

type 

UTILSPIF 

CHINPUTREC 

type 

UTILSPIF 

CHWAIT 

type enum : CHUAITMODE 

UTILSPIF 

CHUAITMODE 

type 

UTILSPIF 

CLEAN_UP_IO 

procedure 

UTILSPIF 

CLEAR_LINE 

procedure 

UTILSPIF 

CLEAR_SCREEN 

procedure 

UTILSPIF 

CLOCKTICK 

function 

UTILSPIF 

CPUTICK 

function 

UTILSPIF 

CRSP 

function 

UTILVEMQ 

DATELEN 

const 

UTILSPIF 

DATESTR 

type 

UTILSPIF 

DATESTRING 

function 

UTILSPIF 

DEGPERRAD 

const 

UTILMATH 

DIAG3X3 

type 

UTILVEMQ 

DIAGMAT 

type 

UTILMATH 

DIAGONALIZE 

procedure 

UTILVEMQ 

DI AGONAL I ZE_S YMMATRI X 

procedure 

UTILMATH 

DOTP 

function 

UTILVEMQ 


> 
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File ’ Ut il indx . I ' Page Z 


Updated 3 Z3:05:Z8 Sat Z7 Sep 1986 


$ page $ 

< 


Identifier 


Declaration Parent Source 

Category Identifier Module 


EIGHT 

ENDOFLINE 

EULARR 

EUL0E6 

EULPRY 

EULPYR 

EULRAD 

EULRPR 

EULYRY 

FETCHLN 

FIVE 

FIXED_INPUT 

FOUR 

FRAC 

GAUSSIAN_RANDOM_SCALAR 

GAUSSIAN_RANDOM_SIXVECTOR 

GOTWHAT 

H 

HAFPI 

HMS 



IDN3X3 
IMATQ 
I MAX 
I MIN 

INITIALIZE_IO 

INT 

INTEGER_INPUT 
INVERT_MATRIX 
I ROT 
ISIGN 

J 

JULIAN_DAYNUM 

K 

LINELEN 

LINESTR 

LOITER 

LP 

> 



const 

: UTILMATH 

type enum : 

GOTWHAT : UTILSPIF 

type 

: UTILVEMQ 

function 

: UTILVEMQ 

type 

: UTILVEMQ 

type 

: UTILVEMQ 

function 

: UTILVEMQ 

type 

: UTILVEMQ 

type 

: UTILVEMQ 

procedure 

: UTILSPIF 

const 

: UTILMATH 

function 

: UTILSPIF 

const 

: UTILMATH 

function 

: UTILMATH 

function 

: UTILSTAT 

function 

: UTILSTAT 

type 

: UTILSPIF 

rec field : 

QUATERNION : UTILVEMQ 

const 

: UTILMATH 

function 

: UTILMATH 

rec field : 

QUATERNION : UTILVEMQ 

const 

: UTILVEMQ 

function 

: UTILVEMQ 

function 

: UTILMATH 

function 

: UTILMATH 

procedure 

: UTILSPIF 

function 

: UTILMATH 

function 

: UTILSPIF 

procedure 

: UTILMATH 

f unct ion 

: UTILVEMQ 

function 

: UTILMATH 

rec field : 

QUATERNION : UTILVEMQ 

function 

: UTILMATH 

rec field : 

QUATERNION : UTILVEMQ 

const 

: UTILSPIF 

type 

: UTILSPIF 

procedure 

: UTILSPIF 

var 

: UTILSPIF 
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File ’Utilindx.I’ Page 3 


Updated @ Z3:05:Z8 Sat Z7 Sep 1S86 


$ page $ 


Identifier 

Declaration Parent 

Category Identifier 

Source 

Module 

MAT3X3 

type 

UTILVEMQ 

MATROWCOLNUM 

type 

UTILMATH 

MAXMATORDER 

const 

UTILMATH 

MAXSQUARE INDEX 

const 

UTILMATH 

MAXTRIANG INDEX 

const 

UTILMATH 

MDIF 

function 

UTILVEMQ 

MINV 

function 

UTILVEMQ 

MOVEJJP 

procedure 

UTILSPIF 

MSUM 

function 

UTILVEMQ 

MTXM 

function 

UTILVEMQ 

MXM 

function 

UTILVEMQ 

MXMT 

function 

UTILVEMQ 

NAMELEN 

const 

UTILSPIF 

NAMEPAC 

type 

UTILSPIF 

NAMESTR 

type 

UTILSPIF 

NAMESTRING 

function 

UTILSPIF 

NINE 

const 

UTILMATH 

NOCHECHO 

type enun : CHECHOMODE 

UTILSPIF 

NOCHWAIT 

type enun : CHWAITMODE 

UTILSPIF 

NOTHING 

type enun : GOTUHAT 

UTILSPIF 

ONE 

: const 

: UTILMATH 

PI 

const 

UTILMATH 

PROMPTLEN 

const 

UTILSPIF 

PROMPTSTR 

type 

UTILSPIF 

PRYQ 

function 

UTILVEMQ 

PYRQ 

function 

UTILVEMQ 

Q 

rec field : CHINPUTREC 

UTILSPIF 

QCXQ 

function 

UTILVEMQ 

QMAT 

f unction 

UTILVEMQ 

QPRY 

function 

UTILVEMQ 

QPYR 

function 

UTILVEMQ 

QRPR 

function 

UTILVEMQ 

QUATERNION 

type 

UTILVEMQ 

QXQ 

function 

UTILVEMQ 

QXQC 

function 

UTILVEMQ 

QYRY 

function 

UTILVEMQ 
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File ’Utilindx.I’ Page 4 


Updated @ Z3:05:28 Sat 27 Sep 198G 


$ page $ 

< 

Identifier 


RADPERDEG 

RANDOM_I NTEGER 

RANDOMINT 

RESTORE_CURSOR 

RJWORD_INPUT 

RMAX 

RMIN 

RMOD 

ROT 

RPRQ 

RSIGN 

RUNNUM 

S 

SECS 

SETJBRIGHBLI NK_I NVERSE_VI DEO 

SET_HALFBRIGHT_INVERSE_VIDEO 

SET_NORMAL_VIDEO 

SEVEN 

SHOW 

SHOWLN 

SIX 

SIXPOPDEF 

SI XTUC_MATRI X 

SIXVEC 

SOMETHING 

SOUND_ALARM 

SOUND_ALERT 

SQUAREMAT 

START_NEU_PAGE 

START_RANOOM_NUMBER_SEQUENCE 

SUPPRESS_CURSOR 

SXV 

SYMM3X3 

TEN 

THREE 

TICKSPERSEC 

TRIANG.INDEX 

TRIANG6XG 

TRIANGMAT 

TWO 

TWOPI 

} 


Declaration Parent 

Category Identifier 

Source 

Module 

const 

UTILMATH 

function 

UTILSPIF 

type 

UTILSPIF 

procedure 

UTILSPIF 

function 

UTILSPIF 

function 

UTILMATH 

function 

UTILMATH 

function 

UTILMATH 

function 

UTILVEMQ 

function 

UTILVEMQ 

function 

UTILMATH 

var 

UTILSTAT 

rec field : QUATERNION 

UTILVEMQ 

function 

UTILMATH 

procedure 

UTILSPIF 

procedure 

UTILSPIF 

procedure 

UTILSPIF 

const 

UTILMATH 

procedure 

UTILSPIF 

procedure 

UTILSPIF 

const 

UTILMATH 

type 

UTILSTAT 

function 

UTILSTAT 

type 

UTILSTAT 

type enun : GOTUHAT 

UTILSPIF 

procedure 

UTILSPIF 

procedure 

UTILSPIF 

type 

UTILMATH 

procedure 

UTILSPIF 

procedure 

UTILSPIF 

procedure 

UTILSPIF 

function 

UTILVEMQ 

type 

UTILVEMQ 

const 

UTILMATH 

const 

UTILMATH 

const 

UTILSPIF 

function 

UTILMATH 

type 

UTILSTAT 

type 

UTILMATH 

const 

UTILMATH 

const 

UTILMATH 
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File ’ Utilindx.I’ Page 5 


Updated 8 Z3:05:Z8 Sat Z7 Sep 1986 


$ page $ 
Identif ier 


UNIFORM_RANDOM_SCALAR 

UNIQUAT 

UNITOL 

UPPERCASE 

USER_DECIDES_TO 

V 

VECTOR 

VDIF 

VMAG 

VSUM 

VXD 

VXM 

VXMT 

WORD_I NPUT 

WORDLEN 

WORDSTR 

XUNVEC 

YRYQ 

YUNVEC 

ZER3X3 

ZERO 

ZERVEC 

ZUNVEC 

> 


Declaration 

Parent 

Source 

Category 

Identif ier 

Module 


: function 
: function 
! const 
: function 
: function 


: function 
: const 
•’ type 

: const 

: function 
: const 

: const 
: const 
' const 
: const 


: UTILSTAT 
: UTILVEMQ 
: UTILMATH 
: UTILSPIF 
: UTILSPIF 

: UTILVEMQ 
: UTILVEMQ 
: UTILVEMQ 
: UTILVEMQ 
: UTILVEMQ 
: UTILVEMQ 
: UTILVEMQ 
: UTILVEMQ 

: UTILSPIF 
: UTILSPIF 
: UTILSPIF 

: UTILVEMQ 

: UTILVEMQ 
: UTILVEMQ 

: UTILVEMQ 
: UTILMATH 
: UTILVEMQ 
: UTILVEMQ 


rec f ield : 
type 

function 
f unct ion 
function 
function 
function 
function 


QUATERNION 


{ end File ’Utilindx.I’ > 


¥5068DD68 


1 • 2 -S 



1.3. Mathematical Functions Module 


1 - 3- x 



File ’ Ut ilroath. 1 1 Page 1 Updated @ 23:06:04 Sat Z7 Sep 1986 

$ page $ < begin File ' Ut ilmath. I ’ > 

{ Utility Software Unit for HP-9000 Series 200/300/500 Computers }■ 
nodule UTILNATH ; { Subject : Mathematics 1 


< NASA/JSC/MPAD/TRW : San Wilson } 


export 

const 


{ begin externally visible declarations > 


UNITOL = 

4.0L- 

14 } 

< arithmetical error 

tolerance 

for computed 

> 





i longreal values on 

the order 

of unity 

> 

ZERO 

as 

0.0L0 

; 





ONE 

zz 

1 . 0L0 

5 





TWO 

s 

Z.0L0 

» 





THREE 

a 

3.0L0 

5 





FOUR 

a 

4.0L0 

3 





FIVE 

ss 

S.0L0 

5 





SIX 

ss 

6.0L0 

? 





SEVEN 

a 

7.0L0 

3 





EIGHT 

a 

8.0L0 

3 





NINE 

as 

9.0L0 

3 





TEN 

a 

10.0L0 

3 






DEGPERRAD - 

HAFPI 

PI 

RADPERDEG = 
TUOPI 


5.729577951 308Z3Z5L+1 
1 . 5707963Z67948966L+0 
3. 1 4 1 592653589793ZL+0 
1.7453Z9ZS19943Z95L-Z 
6. 2831853071795864L+0 


{ degrees per radian > 
{ pi / Z > 
< pi } 

< radians per degree } 
< 2 * pi > 


MAXMATOROER = 12 ; < max order of matrx to be invrtd or diagnlzd > 
MAXSQUAREINOEX = MAXMATQRDER * MAXMATOROER ; 

MAXTRIANGINDEX - ( MAXMATQRDER * ( MAXMATORDER + 1 ) ) div Z ? 
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File ' lit ilmath. I ' Page 2 
$ page $ 


Updated 8 23:06:04 Sat 27 Sep 1986 


type 


MATROIJCOLNUM = 1 . . MAXMATORDER ; 


DIAGMAT ■ { an array in which } 

array [ 1 .. MAXMATORDER 1 of longreal ; f the nonzero elements > 

f of a diagonal > 

{ matrix M of order } 

t n <“ MAXMATORDER are stored in the sequence } 

< > 

< MII.11. M12.21 MIn.nl. > 

< } 


TRIANGMAT = { an array in uhich > 

array [ 1 . . MAXTRI ANGINDEX J of longreal; { the nonzero elemnts } 

f of a triangular } 

< matrix M of order } 

< n <- MAXMATORDER are stored in the sequence } 

< } 

i MI1.11, } 

< MM. 21, MC2.21, } 

< , > 

{ Mt1.nl, Mt2.nl, Mtn.nl > 

< > 

{ or > 

< > 

< Mtl.11, } 

f Mf 2 , 1 1 , MI 2 , 21 , } 

< , - , > 

{ Mtn.11, Mtn,21 Mtn.nl, > 

< > 

< depending on whether M is an upper or a > 

{ lower triangular matrix. > 


SQUAREMAT - < an array in uhich } 

array t 1 . . MAXSQUAREINDEX 1 of longreal ; { the elements } 

< of a square } 

< matrix M of order > 
{ n <= MAXMATORDER are stored in the sequence } 


< y 

< MI1.11, Mil, 21 MM.nl, > 

< MI2.11 , Mt 2 ,21 Mt2.nl, > 

< > 

< Mtn.11, Mtn,21, Mtn.nl, } 

< } 


{ uhich is the PASCAL storage order for the > 
< elements of a two-dimensional n x n array. } 
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File * Ut ilmath. I f Page 3 
$ page $ 


Updated @ 23:06:04 Sat 27 Sep 19SG 


function INK X : longreal ) : integer ; 

■C INT is equivalent to the HPL "int" function (also knoun as > 

i the "floor” function). Its value, which is returned to the > 

< calling routine on the stack, is the greatest integer <= X. } 

< NOTE: INK X ) is not equal to trunc( X ) when X < 0 . } 

function FRAC< X : longreal ) : longreal ; 

{ FRAC is equivalent to the HPL "frc" function, which is never > 

< negative. Its value, X - INK X >, nay be different from } 

{ the casual expectation when X < 0 . > 

function RMOD( Y, X : longreal ) : longreal ; 

{ The value of RMGD( Y, X ) is zero when X = 0 ; otherwise its > 

{ value is Y “ X * INK Y/X ). RMQD< Y, X ) is in a sense the 1 

{ (long)real equivalent of the integer expression "J mod I". } 

function RSIGN< X : longreal ) : integer ; 

{ This is the "sign" function of a (long)real number. Its > 

{ value is -1 if X < 0 * otherwise its value is +1 . > 

function I5IGN( I : integer ) : integer ; 

{ This is the "sign" function of an integer number. Its > 

{ value is -I if X < 0 ; otherwise its value is +1 . > 

function IMAX( J, I : integer ) : integer ; 

< This is the integer "maximum" function. Its value is the > 

< greater of its two arguments. > 

function IMIN< J, I : integer ) : integer ; 

< This is the integer "minimum" function. Its value is the } 

< lesser of its two arguments. > 

function RMAX< Y, X : longreal ) : longreal 5 

< This is the (long)real "maximum" function. Its value is the > 

{ greater of its two arguments. > 

function RMIN< Y, X : longreal > : longreal ; 

< This is the (long)real "minimum" function. Its value is the > 

{ lesser of its two arguments. > 
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function ANGDEG( X : longreal ) • longreal ; 

< This function converts an angle from radian measure to de- > 
{ grees. Normally it is used to convert internal values to > 

< measurement units suitable for output, ANGDEG is unique in > 

< that angles output by every other function defined in this > 

< module are measured in radians. > 

function ANGRAD( X : longreal ) : longreal » 

{ This function converts an angle from degree measure to rad' > 
i ians. Normally it is used to convert external values sup- > 

< plied by the user to measurement units suitable for internal > 
f computations. ANGRAD is unique in that the input value must 1 

< of course be measured in degrees, uhereas angles input to } 
{ every other function defined in this module must be measured > 

< in radians. > 

function ANGK X : longreal ) : longreal ; 

< The value of ANGK X ) is the angular equivalent of X that > 

•C lies in the range of 0 <= ANG 1 < X ) < TWOPI. > 

function ANGZ( X : longreal ) : longreal ; 

{ The value of ANGZ( X ) is the angular equivalent of X that > 

{ lies in the range of -PI < ANGZ(X) O PI. > 

function ATANZ( Y, X : longreal ) : longreal ; 

{ The value returned by this function subprogram aluiays lies > 
{ in the range of -PI < ATANZ(Y,X) <= PI and is equal to > 

< arctangent( Y/X ) in the quadrant uhere the sine and cosine > 

{ of the angle have the signs of Y and X, respectively. It is > 
{ equivalent to the FORTRAN function of the same name, except > 
{ that ATANZ(0,0) undefined in FORTRAN is zero. > 

function ATANK Y, X : longreal > : longreal ; 

< ATAN1 is similar to ATANZ , except 0 <= ATANKY.X) < TUGPI. > 
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function HMS( X : longreal ) : longreal ; 

•f HMS converts X (tine neasured in seconds) to hours, minutes, } 
C and seconds, and returns the result packed into a longreal } 

< number. HMS( X ) has the sign of X and the form hmm.ssf, > 
{ where h represents however many decimal digits are required } 
{ to express the number of whole hours, mm and ss represent } 
{ the number of additional whole minutes and seconds, and f } 

< represents the remaining decimal fraction of a second. For } 

< example. HMS< 36385.874 ) = 1006.25874 . } 

function SECS( X : longreal ) : longreal ; 

{ SECS is the inverse of the HMS function. It converts a time } 

{ X expressed in hours, minutes, and seconds, and packed > 

{ into a longreal number of the form hmm.ssf to the equiv- > 

{ alent number of seconds, returning the result as a longreal > 

< number. For example, SECS< 1006.25874 ) = 36385.874 . 1 

function JULIAN_OAYNUM( YEAR , MONTH , DAY : integer ) : integer 5 

{ This function returns the number of the Julian day beginning } 
{ at noon on the date defined by YEAR, MONTH, and DAY numbers } 

< in the Gregorian (i.e., civil) calendar. For example, } 

< JULIAN_DAYNUM( 1980, 4, 2 > = 2444332 is the number of the 1 

< Julian day beginning at noon on Ulednepday, 2 April 1980. > 

function TRIANG_INDEX( i, j : MATROUCOLNUM ) : integer ; 

< The value of this function is the one-dimensional index (in > 

{ an array of the type TRIANGMAT) of the element Mli.jJ from a > 
i triangular matrix M. > 
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procedure INVERTJ1ATRIX ( anyvar MATRIX : SQUAREMAT 5 

ORDER : MATROUCOLNUM s 

anyvar INVERSE : SQUAREMAT ) 5 

{ Given (in MATRIX) the elements of a square matrix of order > 
{ no greater than MAXMATORDER, this procedure will compute the > 
{ elements of its inverse (if it exists) and return them to } 

< the calling routine in the output variable INVERSE. The > 

{. "anyvar" notation in the parameter list causes the normal } 

{ PASCAL type-checking rules to be relaxed, and makes it per- } 
{ missable in the calling routine to substitute, for MATRIX } 

{ and INVERSE, the names of variables that are not actually } 

< declared to be of the type SQUAREMAT. For example, the } 

{ calling routine might legitimately contain the follouing } 

{ statements: } 

< > 

{ type } 

< > 

< MAT4X4 = array I 1..4, 1..4 1 of longreal ; } 

< MAT9X9 = array I 1..9, 1..9 1 of longreal ; } 

< } 

{ var } 

< } 

< L : MAT4X4 5 > 

{ M : MAT4X4 ; } 

i N : MAT9X9 ; } 

< } 

<. begin > 

f . > 

< INVERT_MATRIX ( L, 4, M ) ; > 

< INVERT_MATRIX ( N, 9, N ) ; > 

f . } 

{ end ; } 

< } 

< As indicated by the second reference to INVERT_MATRIX, it } 

< is permissable to substitute the same variable name for } 

i MATRIX and INVERSE if one uishes to overwrite the original } 

{ matrix uith its inverse. } 

{ Program execution will be aborted uith an escapecode of 9901 > 

< if the input matrix turns out to be singular, and no value > 

< uill be assigned to INVERSE. The reference to INVERT_MATRIX } 

< should be embedded in a "try/recover" construct if it is > 

{ desired to provide exception-handling code in the calling > 

< routine to recover from such an eventuality. } 
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procedure DIAGONALIZE_SYMMATRIX < anyvar SYMMET : TRIANGMAT j 

ORDER : MATROWCOLNUM j 

TOLRATIO : longreal ; 

anyvar DIAG : DIAGMAT 5 

anyvar ORTHOG : SQUAREMAT ) ; 

< Given (in SYMMET) the unique elements of a symmetric matrix } 
f S of order no greater than MAXMATORDER, this procedure uses > 

< the Jacobi method of iteration to find an orthogonal matrix > 
{ M that will transform an unknown diagonal matrix D into S by > 

< use of the equation S = T * D * M, where * , * M is the matrix > 
{ multiplication operator and T is the transpose of M. Itera- } 

< tion ceases when a value of M is found such that every > 

< off-diagonal element of an approximated diagonal matrix, } 

f D’ = M * S * T, has an absolute value no greater the product } 

i of the input parameter TOLRATIO with the root-mean-square } 

< magnitude of the diagonal elements of D (which can be com- > 

< puted easily even though the individual elements of D are > 

< unknown). After the convergence test is satisfied, the di- > 

< agonal elements of the approximation D’ are returned to the > 
{ calling routine as components of the output variable DIAG } 

< and the final value of M is returned in the output variable } 
{ ORTHOG. 

< If D’ has not converged to the specified tolerance after a } 

{ reasonable number of iterations (50 times the order of S), } 

< the values of M and D* are NOT returned to the calling } 

{ routine, and program execution is aborted with an escapecode > 

< of 9902. The reference to DIAGONAL I ZE_SYMMATRIX should be > 
{ embedded in a "try/recover" construct if it is desired to } 
t provide exception-handling code in the calling routine to > 

< recover from such an eventuality. } 

{ As in the case of the INVERT_MATRIX procedure, use of the } 

< "anyvar" notation in the parameter list makes it possible in > 

•{ the calling routine to substitute (for SYMMET, DIAG, and } 
{ ORTHOG) the names of variables that are not actually de- > 

{ dared to be of the types indicated in the formal parameter } 
{ list. The DIAGONALIZE procedure code in the UTILVEMQ module } 
{ contains an example of DIAGONALIZE_SYMMATRIX usage. } 
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implement { begin externally invisible part of module 1 

type 

DIAGPOINTER = A DIAGMAT ; 

SQUAREPOINTER = "SQUAREMAT ; 

TRIANGPOINTER - A TRIANGMAT ; 

var 

INV : SQUAREPOINTER i 

MAT : SQUAREPOINTER •, 

MATORDER : integer i 

SYM : TRIANGPOINTER 5 

function SQUARE_INDEX ( i, j : MATROUICOLNUM ) : integer 3 forward ; 
procedure EXCHANGE_ROUS ( i, j : MATROWCOLNUM ) ! forward ; 
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function INK X : longreal > : 
var 

I : integer ; 

begin 

I trunc( X > ; 
if X < ZERO then 

if X <> I then 

I : = I ~ 1 ; 

INI I ; 
end ; 


function FRAC( X : longreal > : 
var 

F : longreal 5 

begin 

F : = X - trunc< X ) ; 
if F < ZERO then 

F F + ONE 5 
FRAC := F ? 
end ; 


function RM0D( Y , X : longreal 
begin 

if X * ZERO 

then RMOD := ZERO 
else RMOD :» Y - X * 

end ? 


integer ? 


longreal 5 


) : longreal ; 


INK Y / X ) 1 
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function RSIGN( X : longreal ) 
begin 

if X < ZERO 

then RSIGN : *= -1 
else RSIGN := 1 ; 

end 5 


function ISIGN< I : integer ) : 

begin 
if I < 0 

then ISIGN := -1 
else ISIGN : = 1 ; 

end ; 


function IMAX( J , I : integer 

begin 
if I > J 

then I MAX :* I 
else IMAX J ; 

end ? 


function IMIN( J , I : integer 

begin 
if I < J 

then IMIN := I 
else IMIN := J 5 

end ; 


function RMAX( Y , X : longreal 

begin 
if Y > X 

then RMAX Y 
else RMAX := X ; 

end ; 


function RMIN( Y , X : longreal 

begin 
if Y < X 

then RMIN := Y 
else RMIN : = X ; 

end ; 


: integer ; 


integer i 


: integer 5 


: integer ; 


) : longreal ; 


> : longreal ; 
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function ANGDEG( X 2 longreal > : longreal ; 
begin 

ANGDEG X * DEGPERRAD ? 
end ; 


function ANGRAD( X 2 longreal ) 2 longreal ; 
begin 

ANGRAD X * RADPERDEG ; 
end ; 


function ANGK X 2 longreal ) 2 longreal ; 
begin 

ANG1 2 = TWGPI * FRAC< X / TWGPI ) 3 
end ? 


function ANGZ( X 2 longreal ) 2 longreal 5 
var 

A : longreal 3 

begin 

A TWOPI * FRAC( X / TWOPI ) ; 

if A > PI then A 2 = A - TWOPI ; 

ANG2 : - A 5 
end ; 
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function ATANZ ( Y , X : longreal ) : 
var 

A s longreal ; 

XSQ : longreal ; 

YSQ : longreal ; 

begin 

YSQ := sqr( Y ) ; 

XSQ := sqr< X > ; 
if< YSQ + XSQ ) - ZERO 

then A := ZERO 

else 

begin 

if YSQ > XSQ 
then 

A : - HAFPI - arctan( 

else 

begin 

A arctan( abs( Y / 
if X < ZERO then A := 
end ; 

if Y < ZERO then A := -A ; 
end 5 

ATANZ :» A ; 
end ; 


function ATANK Y , X : longreal ) : 
begin 

ATAN1 := ANGK ATANZ ( Y, X ) ) 
end 5 


longreal ; 


X / abs( Y ) ) 


X ) ) ; 
PI - A ; 


longreal ; 
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function HMS( X : longreal ) : longreal ; 
var 

A : longreal 3 
H : integer 3 
M : integer 5 
S : longreal ; 

begin 

A := abs( X ) 5 

H := trunc( A/ 3600 ) 3 

M := trunc( A/ 60 ) - 60*H ; 

S:=A-60*<M+ 6 0*H ) 3 

HM5 RSIGN< X ) * ( 100*H + M + S/100 ) 3 

end j 


function SECS( X : longreal ) : longreal ; 
var 

A : longreal 3 
H : integer 3 
M : integer 5 
S : longreal 3 

begin 

A abs( X ) 3 
H :* trunc< A/100 ) 5 
M trunc< A ) - 100*H ; 

S:~100*(A-M- 1 00* H ) 5 

SECS RSIGN( X ) * ( 60 * < G0*H + M ) + S ) 3 

end ; 


function JULI AN_DAYNUM< YEAR , MONTH , DAY : integer ) : integer ; 
var 

D : integer ; 

I : integer 3 

begin 

if MONTH < 3 

then I :« 1 
else I s* 0 3 

D := DAY - 32075 + ( 1461 * ( YEAR + 4800 - I > ) div 4 3 
D := D + ( 367 * ( MONTH - 2 + 12*1 ) ) div 12 3 

D :* D - ( 3 * ( < YEAR + 4900 - I ) div 100 ) > div 4 3 

JULIANJDAYNUM D 3 
end ; 
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function TRIANG_INDEX< i, j : MATROUCOLNUM ) 
var 


h : MATROUCOLNUM ; 
k : MATROUCOLNUM j 

begin 

h := IMIN( i, j ) ; 
k := IMAX< i, j ) 5 

TRI ANG_INDEX : = h + ( k * ( k- 1 ) ) div 
end ; 


function SQUARE_INOEX< i, j : MATROUCOLNUM ) : 
begin 

SQUARE_INDEX := j + ( i - 1 ) * MATORDER 5 
end ; 


integer ; 


integer ; 
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procedure INVERT_MATRIX < anyvar MATRIX 

ORDER 

anyvar INVERSE 


SQUAREMAT ; 
MATROWCOLNUM ; 
SQUAREMAT ) 


var 


BESTROW 

MATROWCOLNUM 

BESTVAL 

longreal 

i 

MATROWCOLNUM 

ij 

integer 

ik 

integer 

j 

MATROWCOLNUM 

k 

MATROWCOLNUM 

kj 

integer 

kk 

integer 

MIK 

longreal 

X 

longreal 

Y 

longreal 

Z 

longreal 

begin 

MATORDER := ORDER j 

new < MAT ) 5 

< 

new ( INV ) j 

< 

BESTVAL :=■ ZERO ; 

for i :« 1 to 

MATORDER do 


allocate storage for working copy of MATRIX > 
allocate storage for working copy of INVERSE } 


for j 1 to MATORDER do 
begin 

ij := SQUARE_INDEX( i, j ) 
if j = i 

then INV A [ i j ] := ONE 
else INVMij] := ZERO 
MAT A t i j 1 :=■ MATRIX! ij] ; 
if j = 1 then 
begin 

X : = abs( MAT* I i j 1 ) ; 
if X > BESTVAL then 
begin 

BESTVAL := X 5 
BESTROW := i ! 
end ; 


end 


end 
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for Ic s- 1 to MATORDER do 


begin < k loop 1 


if BESTVAL = ZERO then escape ( 9901 ) ; { MATRIX is singular 1 

if BESTROW <> k then 

EXCHANGE_ROUS( k, BESTROW ) ; 
kk SQUARE_INDEX( k, k ) ; 

X := ONE / MAT” [ kk ] i 
for j := 1 to MATORDER do 
begin 

kj := SQUARE_I NDEX( k, j ) j 
MAT” [ k j ] := X * MAT”[k j ] s 
INV” [ k j ] := X * INV”[kj] 
end ; 

BESTVAL := ZERO ; 


for i := 1 to MATORDER do 

if i <> k then { nullify column k of rou i in MAT } 

begin 

ik : * SQUARE_I NDEX< i, k ) ; 

MIK := MAT”!ik] 5 
for j := 1 to MATORDER do 
begin 

ij := SQUARE_INDEX( i, j ) 5 

kj :■= SQUARE_INDEX< k, j ) 1 

Y := MAT” t ij ] 5 
Z := MIK * MAT” [ k j ] 5 
MAT” ! i j ] := Y - Z 5 

INV”! ij 1 := INV” ! i j J - MIK * INV”!kj] 5 

if ( j = k+1 ) and < i > k > then 


begin 


X := RMAX( abs( Y ), abs( Z ) ) 5 
if X > ZERO then 


begin 

X := abs( MAT”! ij 1 / X ) } 
if X > BESTVAL then 


end 


begin 
BESTVAL 
BESTROW 
end ; 

end ; 

end ; 

end 5 


X } 
i 5 


end j i k loop > 
for i := 1 to MATORDER do 

for j :=* 1 to MATORDER do 
begin 

ij := SQUARE_INDEX( i, j ) 5 
INVERSE! i j ] := INV” I ij 1 5 
end 5 

dispose! MAT ) ; { release temporary storage 1 

dispose! INV ) ; { release temporary storage > 

end ; 
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procedure EXCHANGE_ROUS ( i, j : MATRQUCOLNUM ) ; 


var 


ik 

integer ; 

jk 

integer ; 

k 

MATROWCOLNUM ; 

X 

longreal ; 

Y 

longreal ; 

begin 
for k := 

1 to MATORDER do 


begi 

n 



ik : 

= SQUARE_INDEX< i, It I 

jk : 

= SQUARE_INDEX< j, k ) 

X :» 

MAT" 

[ik] ; 


Y :■= 

INVT 

[ik] ; 


MAT A 

[ikl 

:= MAT* 

[ jk] 5 

INV" 

[ ikl 

:= INV A 

[jk] i 

MAT* 

[jk] 

:= X 5 


INV A 

[ jk] 

:= Y } 


end 

5 




end ; 
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procedure DI AGQNALI ZE_SYMMATRI X ( anyvar SYMMET : TRIANGMAT ? 

ORDER : MATROUCOLNUM 5 

TOLRATIO : longreal 5 

anyvar DIAG : DIAGMAT 5 

anyvar ORTHOG : SQUAREMAT ) j 


var 


ADJUSTED 

CA 

CASQ 

i 

i i 
ij 
ik 

ITNUM 

j 

j j 
jk 
k 

MAXITERATIONS 

RMSEIGENVAL 

SA 

SASQ 

THRESH 

TOL 

X 

Y 

YSACA 

Z 


boolean 

longreal 

longreal 

MATROUCOLNUM 

integer 

integer 

integer 

integer 

MATROUCOLNUM 

integer 

integer 

MATROUCOLNUM 

integer 

longreal 

longreal 

longreal 

longreal 

longreal 

longreal 

longreal 

longreal 

longreal 


; 


5 

s 


begin < procedure DI AGONALI ZE_SYMMATRI X > 

MATORDER := ORDER 5 

neu( SYM ) 5 f allocate storage for working copy of SYMMET > 

neui( MAT ) ; < allocate storage for working copy of ORTHOG } 

Y := ZERO 5 
Z := ZERO ; 

for i := 1 to MATORDER do 

for j := 1 to MATORDER do 
begin 

ij := SQUARE_.INDEX( i, j > ; 
if j = i 

then MAT* [ i j ] := ONE 
else MAT* [ i j 1 := ZERO 5 
if j >■ i then 
begin 

ij := TRI ANG_INDEX( i, j ) 5 
X := SYMMETtijl 5 
SYM*1 i j 3 := X ! 
if j = i 

then Y := Y + sqr( X ) 
else Z s* Z + sqr( X ) ; 

end ; 

end ; 

RMSEIGENVAL sqrt( ( Y + Z + Z ) / MATORDER ) j 
TOL := RMSEIGENVAL * TOLRATIO 5 
THRESH := sqrt< Z ) / MATORDER ; 
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MAXITERATIONS :« 50 * MATORDER ; 

ITNUM :* 0 ; 
repeat 

ADJUSTED := false ; 
for j := Z to MATORDER do 
begin { j loop > 
jj := TRIANG_INDEX( j, j ) ; 
for i := 1 to j - 1 do 
begin < i loop > 
ii := TRI ANG_I NDEX( i, i > ; 
ij := TRIANG_INDEX( i, j ) ; 
if abs( SYM A l i j ] ) > THRESH then 
begin { matrix adjustment > 

X := SYM A Iii] - SYM A [jj] ■, 

Y := TUO * SYM A [ i j ] ; 

Z := Y / sqrt( sqr( X ) + sqr( Y ) ) j 
if X < ZERO then Z := -Z ; 

SA := Z / sqrt( TUO*< ONE+sqrt( 0NE-sqr( Z ) )) ) ; 

SASQ := sqr( SA ) ; 

CASQ ONE - SASQ j 

CA := sqrt( CASQ > ; < CA * cosine of rotation angle > 
YSACA := Y * SA * CA ! 

Z :=■• SYM A I ii] 5 

SYMMiil := Z * CASQ + YSACA + SYM A [jj] * SASQ { 

SYM A Ijjl := Z * SASQ - YSACA + SYM A tjjI * CASQ j 

SYM A tij] := ZERO 5 < but next rotation may change it > 
for k := 1 to MATORDER do 
begin 

if k <> i then 

if k <> j then 
begin 

ik := TRI ANG_INDEX( i, k ) j 

jk := TRIANG_INDEX( j, k ) ; 

Z := SYM A tikl ; 

SYM A Iik] := SYM A fjkl * SA + Z * CA 5 
SYM A t j k ] SYM A Ijkl * CA - Z * SA ; 
end ; 

ik :« SQUARE_INDEX< i, k ) ; 
jk := SQUARE_INDEX( j , k > S 
Z := MAT A [ ik ] ; 

MAT" I ik ] := MAT A Ijkl * SA + Z * CA 5 
MAT A [ j k ] := MAT A [jkl * CA - Z * SA 5 
end ; 

ADJUSTED := true ? 
end ; < matrix adjustment > 
end ; { i loop > 
end ; < j loop > 
if not ADJUSTED then 

if THRESH > TOL then 

begin I threshhold adjustment 1 
THRESH := THRESH / MATORDER ; 

ADJUSTED := true ; 

end i < threshhold adjustment } 

ITNUM := ITNUM + 1 ; 

if ITNUM > MAXI TERATIONS then escape ( 990Z ) ; { abort pgm exect'n 1 
until not ADJUSTED ; 
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for i : = I to MATORDER do 
begin 

ii := TRIANG_INDEX( i, i ) 5 
DIAGti] := SYM*[ ii] 5 
for J :• 1 to MATORDER do 
begin 

ij := SQUARE_INDEX< i , j > ; 

ORTHOGt i j ] := MAT A tij] ; 
end ; 

end ; 

dispose( SYM ) ; { release temporary storage > 

dispose( MAT ) 5 < release temporary storage > 

end 1 < procedure DIAGONAL I ZE_SYMMATRIX } 

end i < module UTILMATH & File ’Utilmath.I’ 1 
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1.4.1. 




Model 216 / Pascal 3.0 Interface Module 


1 


4 . I — x 




TICKSPERSEC = 100 } { Series Z00 clock resolution > 


DATELEN = 24 ; { number of characters in date- and- time string } 
LINELEN = 80 i { max characters in input/output line string > 
NAMELEN = 8 ; < max characters in "name" string > 
PRQMPTLEN = 60 ,• { max characters in prompt string for user input > 
WQRDLEN = 20 ; { max characters in “uord" string > 
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type 


RANDOMINT = 1..maxint-1 ; { pseudorandom integer : 1 .. 2 147483646 > 

DATESTR = string [ DATELEN ] 5 

LINESTR = string [ LINELEN ] 5 

NAMEPAC = packed array [ 1 . . NAMELEN 1 of char ; 

NAMESTR - string t NAMELEN ] ; 

PROMPTSTR = string t PROMPTLEN ] ; 

UORDSTR = string [ UORDLEN 1 ? 


CHWAITMODE = ( < describes wait mode for CHAR_INPUT function > 

CHUAIT, < wait if input buffer is empty > 

NQCHUAIT ) i < don’t wait if input buffer is empty } 

CHECHOMODE = ( < describes echo mode for CHAR_INPUT function > 

CHECHO, < echo characters back to user terminal screen > 

NOCHECHO ) ? < don’t echo characters back to user terminal > 

GOTUHAT = ( -C describes result of executing CHAR_INPUT functn > 

NOTHING, < the input buffer uas empty <& didn’t wait) > 

ENDOFLINE, C got an end-of-line char ( <RETURN> keystroke) > 

SOMETHING )j { got a character that uas not end-of-line } 

CHINPUTREC = 

record < returned by the CHAR_INPUT function > 

Q : GOTUHAT 5 I qualifier for the returned character > 

C : char ? { C = ’ ’ if 0 = NOTHING or ENDOFLINE? } 

end ? < record > { else C = char produced by user keystroke > 


var 


LP : text ; t standard file for printed output; must be > 

{ opened by "reurite" statement someuhere in > 
f program before use > 


- 4 _ 


¥66C29E82 


1 


1 - 2 



File * UTILSPIF . I ’ Page 3 
$ page $ 


Updated @ 23:07:52 Sat 27 Sep 1986 


procedure INITIALIZE_IG ; 

i This procedure performs the I/O system initialization re- > 
{ quired to support most applications. Normally it should be > 
i the first procedure called by any program. > 

procedure CLEAN_UP_IO ; 

{ This procedure closes any open files and generally cleans > 
i up the I/O system. Normally it should be the last procedure > 
( called by any program. } 

procedure CLEAR_LINE ; 

i This procedure clears the line on the user terminal where > 
{ the cursor is currently located. > 

procedure CLEAR_SCREEN ; 

{ This procedure clears the user terminal screen. > 

procedure FETCHLN ( var STR : LINESTR ) ; 

{ This procedure reads < and thus removes) characters from the > 

< user terminal input buffer storing them in the string > 

i variable STR until an end-of~line character (generated > 

f by a <RETURN>* keystroke) has been read. The end-of-line > 
i character is always discarded, along with any other charac- > 
{ ters in excess of the number (LINELEN) needed to fill the > 
{ variable STR to its maximum capacity. > 

{ * NOTE: Some keyboards, instead of having a <RETURN> key, > 

{ have an <ENTER> key that serves the same purpose. > 

< Wherever "<RETURN>" appears in this and following > 

< descriptions, it should be interpreted as '*<RETURN> > 

< or <ENTER>, whichever is present on the keyboard". > 

procedure LOITER ( MILLISECS : integer ) ; 

{ This procedure loops through meaningless code (effectively > 

< suspending program execution) for the number of milliseconds > 

i specified in its argument. > 

procedure SUPPRESS_CURSOR ; 

{ This procedure suppresses normal cursor visibility. > 

procedure REST0RE__CURS0R ; 

{ This procedure restores normal cursor visibility. > 
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procedure MGVE_UP ? 

{ This procedure moves the cursor up one line on the user > 

{ terminal. > 

procedure SETJ3RIGHTBLINK_JNVERSE_VIDE0 5 

{ This procedure causes characters to be written on the user } 

< terminal screen in the blinking bright inverse video mode, > 

{ which remains in effect until another mode is specified. > 

procedure SET_HALFBRI GHT_I N VER5E_V I DEO 5 

{ This procedure causes characters to be written on the user } 
{ terminal screen in the half bright inverse video mode, > 

{ which remains in effect until another mode is specified. } 

procedure SET_NORMAL_VIDEO ? 

i This procedure causes characters to be written on the user > 

{ terminal screen in the normal video mode, which remains in > 

{ effect until another mode is specified. > 

procedure SHOW < STR : LINESTR ) 5 

{ This procedure writes a PASCAL string to the user terminal. > 

procedure SHOWLN ( STR : LINESTR ) ; 

{ This procedure writes a PASCAL string to the user terminal, > 

< and then positions the cursor at the beginning of the next > 

< line. } 

procedure SOUND_ALERT ; 

< This procedure causes an audible signal to be sounded at the > 
{ user terminal, often to indicate that the program is waiting > 

< for input from the user, sometimes < in real-time simulators) > 

< to indicate that the program is ignoring an attempted input > 

< because it is not valid or not capable of timely implementa- > 

{ tion in the current circumstance. } 

procedure SOUND_ALARM 5 

{ This procedure causes a distinctive audible signal to be > 

< sounded at the user terminal, usually to indicate that some > 

< error condition has occurred that requires corrective action > 

{ on the part of the user. > 
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procedure START JMEWJ’AGE ? 

{ This procedure causes a page-eject character to be written > 
{ to the standard printed-output file LP, which must have been > 
i opened somewhere in the program with a “rewrite" statement. > 

procedure START_RANDOM_NUMBER_SEQUENCE ( SEED : RANDOM NT > ; 

< This procedure uses the argument SEED to initiate a repeat- } 

i able sequence of pseudorandom numbers. > 

function RAND0M_I NTEGER : RANDOMINT ? 

< This function returns a pseudorandom integer from a uniform } 

i distribution in the range of I to MAXINT-1 (i.e., in the } 

< range of 1 to 2147483646). > 

function CLOCKTICK : integer 5 

i This function returns an integer corresponding to the number > 

< of "ticks" registered on the system clock since some arbi- > 

i trary fixed time in the past. } 

function CPUTICK : integer ? 

{ This function returns an integer number that grows at the > 

< rate of the expenditure of CPU time (measured in system > 

< clock "ticks") to support the calling process. > 

function DATESTRING : DATESTR ? 

< This function returns a PASCAL string describing the current > 
{ date and time in the form, e.g. , "17:32:25 Tue 18 Feb 1986". } 

function NAMESTRI NG( PAC : NAMEPAC ) : NAMESTR 5 

{ This function returns a PASCAL string formed by removing > 

< any blank spaces found in the input PAC (packed array of > 

{ characters). > 

function UPPER_CASE( C : char ) : char ; 

f If C is a lower-case letter of the alphabet this function > 

{ returns its upper-case counterpart? otherwise it returns > 

{ C unchanged. > 
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function CAPW0RD< WORD : WQRDSTR ) : WORDSTR ; 

{ This function returns a string formed by replacing all } 

{ lower-case letters in the input WORD ( if any) with their > 
{ upper-case counterparts. > 

function CHAR_INPUT( WMODE : CHUAITMODE ; 

EMODE : CHECHOMODE ) : CHINPUTREC ; 

{ If the user terminal input buffer is empty when this func- > 
{ tion is called, it will will either uait for a character to > 

< be input or return immediately to the calling routine, de- } 

< pending on uhether the value of WMODE is CHWAIT or NOCHWAIT. > 

< Whenever it finds the buffer unempty, it removes one char- } 
{ act er and if the value of EMODE is CHECHO it echoes that } 
{ character back to the user terminal. If WMODE * NOCHWAIT } 
{ and the input buffer is empty then the value of CHAR_INPUT.Q > 
{ is NOTHING; if an end-of-line character is read from the > 
{ buffer (the result of the user having pressed the <RETURN> > 
{ key) then the value of CHAR_INPUT.Q is ENDOFLINE; otherwise } 

< the value of CHAR.INPUT.Q is SOMETHING and the value of > 

{ CHAR_INPUT.C is the character that was read from the buffer. > 
{ CHAR_INPUT.C = ’ ’ (the space character) when the value of } 
{ CHAR_INPUT.Q is NOTHING or ENDOFLINE. > 

function USER_DECIDES_TO( DO_THIS : PROMPTSTR ) : boolean ; 

i The DQ_THIS input string should describe a tentative action, > 

< and after appending the characters ’ ? ’ it should also form > 
{ a question that can be answered "yes'* or M no'‘ by the user > 
{ (with a single keystroke, as explained below). The boolean > 

< value of this function is TRUE if the user's answer is “yes" } 

{ and FALSE if the answer is “no". > 

i The USER_DECIDES_TQ function code causes the D0_THIS string, > 
{ followed by the characters ’ ? ', to be displayed on the } 

{. user terminal screen in normal video mode, and then it waits } 
t for the user to press a single key indicating his decision. } 
i Pressing *Y’, 'y', or the <RETURN> key indicates "yes". If } 
{ the user presses 'H' ,’h', or '?' (thinking perhaps to obtain > 
{ a further description of available options), the SOUND_ALARM } 

< procedure is invoked to give an audible error signal. Any } 
{ other keystroke is interpreted as “no". As soon as an an- } 
{ suer is received, an appropriate character string ('YES' or > 
{ 'NO') is displayed in half-bright inverse video mode immed- > 
{ iately behind the prompting question, and the corresponding > 

< boolean value (TRUE or FALSE) is returned to the calling } 

< routine. } 
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function WORD_INPUT( PROMPT : PROMPTSTR 5 

DEFAULT : UORDSTR ) : UORDSTR 5 

< The PROMPT string, folloued by the characters 1 : 1 , is dis- > 

< played on the user terminal screen in normal video mode and > 

< folloued on the same line by a display of the DEFAULT value > 
{ in blinking bright inverse video mode, signifying that the > 
■C user may approve the blinking value as shown or else supply } 
{ another value (which will replace the one currently blinking > 
f and become the neu value to be approved or replaced). When > 
{ satisfied with the blinking value, the user terminates the > 
i input process with a single <RETURN> keystroke (i.e., one > 

< that is not preceded by any other keystroke). This causes > 

< the display mode of the blinking value to be downgraded to > 
{ steady half-bright inverse video, indicating its acceptance > 

< by the user. The user-approved value (a character string) > 

< is returned (on the stack) to the calling routine as the } 

{ value of the functon UORD_INPUT. > 

{ If the PROMPT string does not contain a pair of braces (like > 

< the ones enclosing each of these comment lines), then the } 

< user may type in any character string of his choosing, > 

f which must be terminated with a <RETURN> keystroke. After > 

< deleting any leading or trailing blank spaces, and any other > 

< characters in excess of the number (UORDLEN) required to > 

< fill the INPUT_UORD function value to its maximum capacity, > 
{ the value thus supplied will replace the previous blinking > 
{ value on the user terminal screen. This cycle is repeated > 

< until a blinking value is approved in the fashion described } 

{ in the preceding paragraph. > 

i Braces like the ones enclosing this line if present in > 

< PROMPT contain a comma-separated list of the only char- > 

{ acter strings that are permissable input values, from which > 
{ the user must make a choice. If the blinking value is not > 
i acceptable to the user, pressing the f -* or the key will > 

{ cause its predecessor in the list to be displayed in the > 

< blinking mode for possible approval? pressing any other key > 
{ except <RETURN> will cause its successor in the list to be > 

< displayed instead. Running off the end of the list in > 

< either direction causes a "wraparound * 1 to the opposite end. > 

< The maximum number of values allowed in the list is ten. > 

function RJUORD_INPUT< PROMPT : PROMPTSTR ; 

DEFAULT : UORDSTR ? 

FIELD : integer ? 

MAXLEN : integer ) : UORDSTR ? 

{ This function works exactly like UORD_INPUT except that the > 

< the user-input "word", when displayed on the user terminal > 
{ screen, is right-justified in a space at least FIELD columns > 

< wide, and the length of the "word" is constrained to be no > 

< greater than MAXLEN. > 
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function INTEGER_I NPUT( PROMPT : PROMPTSTR * 

DEFAULT : integer i 

FIELD : integer ) : integer ; 

{ This function works very much like RJUORD_INPUT except of } 
{ course the function value is an integer instead of a string, 1 
{ which makes the MAXLEN argument of RJUORD_INPUT inappropri- } 

< ate in this case. If the user types in a number in fixed- > 
{ point decimal format, it is truncated to make it an integer > 

< (i.e., the decimal point and any characters following it are > 

< ignored). Any attempt on the part of the user to input a } 

< non-numeric value causes an audible error signal to be pro- > 
■f duced by the SOUND_ALARM procedure, and the blinking value > 

< remains unchanged. y 

function FIXEO_INPUT< PROMPT : PROMPTSTR s 

DEFAULT : longreal ; 

FIELD : integer ; 

PLACES : integer ) : longreal ? 

< This function is similar to INTEGER_INPUT except that the } 
{ function value is a longreal number instead of an integer. > 

< A fixed-point format is always used to display the function > 
{ value on the user terminal screen, and the PLACES argument > 

< specifies how many digits are to be shown after the decimal > 
■C point. If the user types in a number with more digits than > 

< what is called for by the PLACES argument, it is rounded to } 

{ the nearest decimal digit in the last place shown on the } 

i screen. The same applies to the DEFAULT value supplied > 

{ by the calling routine. Within the limits of precision that > 

< are inherent in the transf ormation between the binary and > 

{ the decimal representation of a number, the function value } 
{ returned to the calling routine is exactly that which is } 

■C shown to the user, with no significant decimal digits lurk- > 

< ing unseen beyond the last one displayed (i.e., "what you } 

{ see is what you get"). > 

{ This function does not require user input to be typed in a > 
{ fixed-point format. Integer format is acceptable for whole > 
•C numbers, and it is not necessary to type "0" before the dec- } 

< imal point of a fraction nor behind that of a whole number. 1 

{ An exponential format may be used if that is the user’s } 

{ preference. For example, the value displayed on the user > 

< terminal screen and returned to the calling routine > 

<. as "150.00" may have been typed in by the U6er as "149.996", > 
{ "150", "150.", "1.5+Z", " 1 . 5eZ" , or " 1 .499963LZ" . If the > 
i user attempts to input a non-numeric value, FIXED_INPUT will > 
{ call the SQUND_ALARM procedure to produce an audible error > 
{ signal, and the blinking value will remain unchanged. > 
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const 


BLINK 

St 

chr< 

130 

) 

? 

BRIGHT I 

st 

chr< 

129 

) 

? 

BRIGHTBLINKI 

SI 

chr( 

131 

) 


CLEARTOEOL 

s= 

chr( 

009 

) 


CLEARTOEOM 

s 

chr< 

01 1 

) 


FORMFEED 

s 

chr( 

012 

) 


G0T0C0LZER0 

=a 

chr< 

013 

) 


HALFBRIGHTI 

- 

chr( 

137 

) 


HOMEUPLEFT 

as 

chr( 

001 

) 

5 

M0VEUP1R0U 

a 

chr( 

031 

) 

1 

NORMAL 

tax 

chr( 

128 

) 

! 

UNDERLINE 

vet 

chr( 

132 

) 

! 


type 

STRING3 => string 13 1; 

REGNUM_6845 » #10.. #15 ? i see ** NOTE below > 

var 

RANDOMSEED : RANDOM NT ; 

REGSELECT [ hex( '510001’ ) 3 : REGNUM_6845 i { see ** NOTE below > 

CRTREGVAL [ hex( ’510003’ ) 3 : char i 


< ** NOTE: The ordinal value of REGSELECT is the number > 
{ of a 6845 CRT controller register into which > 
{ a value (CRTRE6VAL) is to be written for the > 

< purpose of changing CRT attributes. The SDG > 
{ (Pascal 3.0 System Designers Guide) says that > 

< changing the contents of 6845 registers 0..9 > 
•C can damage the CRT drive circuitry, so DO NOT > 
■C repeat DO NOT change the REGNUM_6845 subrange > 
{ specification < "#10. .#15" ) . > 


- 4 . 
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procedure INITIALIZER ; 
begin 

Ioinitialize ! 

RANDOMSEED := IMAX< 1, IMIN< naxint-1. CLOCKTICK ) ) ; 
end ; 


procedure CLEAN_UP_IO ; 
begin 

RESTQRE_CURSOR ; 
Iouninitial ize ; 
end ; 


procedure CLEAR_LINE j 
begin 

write ( GOTQCOLZERO.CLEARTOEOL ) 5 
end ] 


procedure CLEAR_SCREEN } 
begin 

write ( HOMEUPLEFT , CLEARTOEQM ) ; 
end ; 


procedure FETCHLN ( var STR : LINESTR > 5 
begin 

readln ( STR ) 5 
end ; 


procedure LOITER ( MILLISECS : integer ) 5 
var 

TICK : integer j 
TOCK : integer ; 

begin 

TOCK :*= Sysclock + ( TICKSPERSEC * MILLISECS ) div 1000 5 
repeat 

TICK := Sysclock ; 
until TICK > TOCK 5 

end ; 
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procedure SUPPRESS_CURSOR } 
begin 

REGSELECT :* chr( 10 > s { select 6845 register #10 > 

CRTREGVAL := chr( binary( ’00101011’ ) ) ; < turn cursor "off" } 

< bit # 76543Z 10 see p. Z79 of Pascal 3.0 SDG } 

end ; 

procedure REST0RE_CURS0R ; 
begin 

REGSELECT : - chr( 10 > ? < select 6845 register #10 } 

CRTREGVAL s* 5 chr( binary( '0100101 1 ’ ) ) ; ■{ turn cursor "on" 1 

{ bit # 76543Z10 see p. Z79 of Pascal 3.0 SDG > 

end j 


procedure M0VE_UP ; 
begin 

unite ( M0VEUP1R0U > j 
end i 


procedure SE T_BRI GHTBL I NK_I N VE RSE_V I DEO 5 
begin 

unite < BRIGHTBLINKI ) ? 
end ; 

procedure SET_HALFBRIGHT_INVERSE_VIDEO 5 
begin 

urite ( HftLFBRIGHTI > s 
end ; 

procedure SET_NORMAL_VIDEO 5 
begin 

urite ( NORMAL ) 5 
end ; 


procedure SHOU < STR : LINESTR ) j 
begin 

urite < STR ) j 
end j 

procedure SHOWLN ( STR : LINESTR ) ; 
begin 

uriteln ( STR ) ; 
end ; 
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procedure SOUND_ALERT ; 

begin 
Beep 3 
end ; 


procedure SOUND_ALARM 5 
begin 

Beeper ( 3, 50 ) 3 
LOITER < E00 ) ; 
end 1 


procedure START_NEW_PAGE ; 
begin 

write ( LP, FORMFEED ) ; 
end 3 


procedure START_RAND0M_NUMBER_5EQUENCE ( SEED : RANDOMINT ) 3 
begin 

RANDOMSEED SEED 3 
end 5 


function RANDQM_I NTEGER : RANDOMINT ; 
var 

I : integer ? 

begin 

I RANDOMSEED 3 
Random < I ) ; 

RANDOMSEED :** I 3 
RANDOM_I NTEGER := I 3 
end 3 


function CLOCKTICK : integer 3 
begin 

CLOCKTICK Sysclock ; 
end 3 


function CPUTICK : integer ; 
begin 

CPUTICK : a Sysclock 3 
end i 
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function DATESTRING : DATESTR ; 
type 


DAYARR = array [ 0. . B 1 of STRING3 ; 

MONARR = array t 1 ..12 ] of STRING3 ; 

const 

DAYNAME = DAYARR [ ’ Sun’ , ’ Mon’ , ’ Tue’ , ’ Wed” , ’ Thu’ , ’ Fri 1 , ’ Sat ’ ] ; 
MONNAME = MONARR [ * Jan’ , ’Feb’ , ’Mar’ , ’Apr" , ’May* , * Jun* , 

’Jul’ ,’Aug’ ,’Sep’ .’Oct’ ,’Nov’ .’Dec’ ] ; 

var 

D : integer ; 

DATE : Daterec ; 

K : integer ; 

JD : integer ; 

SECOND : integer ; 

TIME : Timerec ; 

WORK : DATESTR j 

YR : integer i 

begin 

Sysdate ( DATE ) ; 

Systime ( TIME ) \ 
with DATE, TIME do 
begin 

SECOND := round! Centisecond / 100 ) ; 

YR :*= 1900 + Year i 

JD := JULIAN_DAYNUM( YR, Month, Day) ; 


D 

:= ( JD 

+ 1 ) mod 

7 ! 






WORK := ” 

' 3 








if 

Hour < 

10 









then 

strurite 

( 

WORK, 

1 , 

K, 

*0’ .Hour: 1 , ’ : ’ 

) 



else 

strur ite 

< 

WORK, 

1, 

K, 

Hour: 2.’: • 

) 

» 

if 

Minute 

< 10 









then 

strurite 

< 

WORK, 

K, 

K, 

’0* .Minute: 1 , ' : 

1 

) 


else 

strurite 

< 

WORK, 

K, 

K, 

Minute:2, * : 

* 

) 

if 

SECOND 

< 10 









then 

strurite 

( 

WORK, 

K, 

K, 

’0’ , SECOND: 1 , ’ 

1 

) 


else 

strurite 

( 

WORK, 

K, 

K, 

SECOND: 2,’ 

1 

) 


struirite < WORK, K, K, DAYNAME ID) , ’ ’ > j 
if Day < 10 

then strurite ( WORK, K, K, ’0’,Day:1,’ * ) 
else strurite ( WORK, K, K, Day: 2,’ ’ ) j 
strurite ( WORK, K, K, MONNAME I Month] , ’ • ) ; 
strurite ( WORK, K, K, YR:4 > 5 
end 5 

DATESTRING := WORK 5 
end ; 
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function NAMESTRING ( PAG : NAMEPAC ) : NAMESTR ; 
var 

i : integer * 
n : integer ; 

WORK : NAMESTR ; 

begin 

aetstrlen( WORK, NAMELEN ) ? 
n :* 0 i 

for i :* I to NAMELEN do 

if PACIi] <> * # then 
begin 

n :* n + 1 ; 

WORK [ n] :* PAdi] ; 
end i 

setstrlen ( WORK, n ) ; 

NAMESTRING :» WORK ? 
end « 


function UPPER_CASE( C : char ) : char ? 
var 


K : integer ; 


begin 

K ord( C ) ; 

if K >~ ord( *a* ) then 

if K <* ord< 1 z * ) then 

C :=* chr( K + ord( ’A 1 > * ord< 
UPPERCASE : - C ; 
end ? 


function CAPWORD( WORD : WORDSTR ) : WORDSTR ; 
var 


i : integer ; 
n : integer ; 


begin 

n :* strlen( WORD ) ; 
if n > 0 then 

for i :® 1 to n do 

WORDC i ] UPPERCASE ( WORDfi] ) ; 

CAPWORD WORD ? 
end ; 


’a* ) > ; 
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function CHAR_INPUT< UMODE : CHUAITMODE i 

EMODE : CHECHOMODE ) : CHINPUTREC j 


var 


S : string [11; 
WORK : CHINPUTREC ; 


begin 

case UMODE of 

NOCHUAIT : 
begin 

if Keybuf f er A . Size » 0 

then WORK . Q := NOTHING 

else 

begin 

Keybufops ( Kgetchar, UORK.C ) ; 
if UORK.C = chr( 013 ) 

then UORK.Q := ENDOFLINE 
else UORK.Q :-= SOMETHING j 

end ; 

end ; 

CHWAIT : 
begin 

uhile Keybuf f er* . Size =■ 0 do 
UORK.C • • s 

Keybufops < Kgetchar, UORK.C ) ; 
if UORK.C = chr( 013 ) 

then UORK.Q := ENDOFLINE 
else UORK.Q := SOMETHING j 

end { 

end ; { case UMODE > 
if UORK.Q <> SOMETHING then 
UORK.C := ' ' } 
if EMODE - CHECHO then 
begin 

setstrlen ( S, 1 > 5 
sm :- UORK.C I 
SHOU < S ) j 
end 1 

CHAR_INPUT :» WORK 
end j 


¥F0BF 175F 


1 - 4 . 1-15 



File ’UTILSPIF.I’ Page 1G 
$ page $ 


Updated @ Z3:07:5Z Sat Z7 Sep 198G 


function USER_OECIDES_TO< D0_THIS : PROMPTSTR ) : boolean s 


var 

ANSWER : string! 3 ] ; 
OKAY : boolean ; 
WORK : CHINPUTREC 5 


begin 

SOUND_ALERT j 
repeat 

SHOW ( DO_THIS+’ ? ’ ) ; 

WORK := CHAR_INPUT( CHUAIT, NOCHECHO ) 5 
OKAY :* true 5 
if WORK . Q = ENDOFLINE 

then ANSWER := ’YES’ 

else 

begin 

case WORK.C of 
’Y’ , ’y’ : 

ANSWER := ’YES’ ? 

’H’ ,’h’ 
begin 

OKAY := false 5 
SOUND. ALARM i 
end } 

otherwise 
ANSWER := ’NO’ ! 

end ; f case WORK.C > 

end ; 

CLEAR.LINE 5 
until OKAY 5 

SHOW < D0_THI S+ ’ ? ’ ) 1 
SET_HALFBRI GHT_I NVERSE_V I DEO 5 
SHOW ( ’ ’ +ANSWER+' ’ ) j 
SE T_NORM AL_V I DE 0 ; 

SHOWLN ( ” ) j 
if ANSWER - ’NO’ 

then USER_DECIDES_TO { DO.THIS 1 := false 
else USER_DECIDES_TO < DO.THIS > := true 1 

end ; 


¥EAC9Z3E9 


1 .4. i-ie 



File * UTILSPIF. 1 1 Page 17 
$ page $ 


Updated @ Z3:07:5Z Sat 21 Sep 1986 


function UORD_INPUT< PROMPT : PROMPTSTR j 

OEFAULT : UORDSTR ) : UORDSTR ; 


begin 

WORD.INPUT := RJUORD_INPUT< PROMPT, DEFAULT, 0, UORDLEN ) 
end ; 


function RJUORD_INPUT< PROMPT 

DEFAULT 

FIELD 

MAXLEN 


PROMPTSTR ; 
UORDSTR ; 
integer ; 
integer ) : 


UORDSTR 


var 


base 

integer ; 

current 

integer ; 

DELIM 

integer ; 

FLD 

integer ; 

K 

integer ? 

LBRACE 

integer ; 

LEN 

integer ; 

OPTION 

array [ 0..9 

RBRACE 

integer 5 

SELECT_MODE 

boolean ; 

VALUE 

UORDSTR ; 

VALUE_APPROVED 

boolean ; 

UERK 

CHINPUTREC ; 

UIRK 

LINESTR ; 

UORK 

LINESTR ; 


] of UORDSTR 
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begin < function RJWORD_INPUT > 

MAXLEN IMIN( WORDLEN, MAXLEN > j 
WORK := strltrim! strrtrin< DEFAULT ) > ; 

LEN := IMIN( MAXLEN, strlen! WORK ) ) ; 

DEFAULT str< WORK, 1 , LEN > 5 
SELECT.MODE := false 5 
L BRACE := strpos! PROMPT, > ; 
if L BRACE > 0 then 
begin 

RBRACE := strpos! PROMPT, 
if RBRACE > L BRACE then 
begin 

SELECT.MODE : = true 5 
base :■ 0 ; 

LEN RBRACE - L BRACE ; 

WORK : ■ str< PROMPT, LBRACE+ 1 , LEN ) ; 
repeat 

DELIM := strpos( WORK, ) ; 

if DELIM = 0 then 

DELIM := strpos< WORK, * >• ) 1 
LEN : «• DELIM - 1 ; 

WIRK strltrim! strrtrim( str( WORK, 1 , LEN ) ) ) { 

LEN :« IMIN< MAXLEN, strlen( WIRK ) ) 5 
OPTION! base! str! WIRK, 1, LEN > j 
strdelete( WORK, 1, DELIM ) 5 
base : = base + 1 5 
until strlen! WORK ) * 0 1 
current : = base i 
repeat 

current := current - 1 ; 

until ( OPTION! current] = DEFAULT ) or ( current ■ 0 ) ; 
DEFAULT := OPTION! current ] ; 
end ; 

end ; 

VALUE :* DEFAULT ? 

SOUND_ALERT ; 
repeat 

SHOW ( PR0MPT+’ : • ) ; 

SET_BRIGHTBLINK_INVERSE_VIDEO 5 

FLD I MAX! FIELD, strlen! VALUE ) > j 

WORK := ” j 

strurite ( WORKJ.K,’ * .VALUE: FLD, ’ ' ) 5 
SHOW ( WORK ) ; 

SET_NORMAL_VIDEO ! 
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if SELECTJIQDE 

then 

begin 

WERK := CHAR_INPUT( CHWAIT, NOCHECHO ) ; 
if WERK.Q - ENDOFLINE 


then VALUE.APPRQVED := true 


else 

begin 

VALUE.APPROVED := false j 
if WERK . C in l 1 

then current :■= ( current - 1 ) nod base 
else current : = ( current + 1 ) nod base 
VALUE := OPTIONt current] 5 
end ; 

CLEAR.LINE 5 
end 

else 

begin 

SHQWLN ( " > i 
FETCHLN ( WORK ) j 
M0VE_UP j 
CLEAR.LINE } 

M0VE_UP ; 

CLEAR.LINE ; 
if strlen( WORK > = 0 

then VALUE.APPROVED := true 

else 

begin 

VALUE_APPROVED :=• false i 

WORK :■ strltrin( strrtrin( WORK ) ) ; 

LEN := strlen< WORK ) 5 
if LEN > MAXLEN 


then 

begin 

LEN :* MAXLEN ? 

SOUND. ALARM ! 
end 

else SOUND.ALERT j 

VALUE := str< WORK , 1 , LEN ) j 
end ; 


end ; 

until VALUE.APPROVED ; 

SHOW ( PR0MPT+* : ' > j 
SET_HALFBRIGHT_INVERSE_VIDEO j 
WORK := ” j 
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strurite < UORKJ.K,’ ’ , VALUE:FLD, ’ • ) 5 

SHOW < WORK > 5 

SET_NORMAL_VIDEO s 

SHQULN ( ” ) s 

RJUORD.INPUT := VALUE ; 

end 5 { function RJWQRD_INPUT Y 
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function INTEGER_INPUT< PROMPT : PROMPTSTR 5 

DEFAULT : integer 3 

FIELD : integer > : integer ; 


var 

integer 3 
integer 3 
integer 3 
boolean ; 
LINESTR ; 


TRIAL. VALUE 
VALUE 

VALUE.APPROVED 


begin 

VALUE := DEFAULT 3 
SOUND. ALERT 3 
repeat 

SHOW < PR 0 MPT+* : * ) 3 
SET.BRIGHTBLINK.INVERSE.VIDEO 3 
WORK : ■ * ’ 3 

strurite < W 0 RK, 1 ,K,’ • .VALUE: FIELD, * ’ > 3 
SHOW ( WORK ) ; 

SET.NORMAL.VIDEO 3 
SHOULN < ” ) 3 
FETCHLN < WORK > 3 
MOVE.UP 3 
CLEAR.LINE 3 
MOVE.UP 3 
CLEAR.LINE 3 
if strlen( WORK ) « 0 


then 

VALUE.APPROVED := true 


else 

begin 

VALUE.APPROVED := false 5 

try { set trap for possible error > 

strread ( WORK, 1, K, TRIAL.VALUE >3 < error here maybe > 

VALUE :=* TRIAL.VALUE 5 

SOUND.ALERT 3 < and jump around “recover" statement > 

recover SOUND.ALARM ; f come here after error, if any } 

end 3 

until VALUE.APPROVED 3 
SHOW ( PROMPT+’ : ' > 5 
SET.HALFBRIGHT.INVERSE.VIDEO 5 
WORK :« ' * 3 

strurite ( WORK.I.K,' VALUE: FIELD, ' 1 ) 5 
SHOW ( WORK ) ; 

SET.NORMAL.VIDEO ; 

SHOWLN ( ” ) 5 
INTEGER.I NPUT := VALUE 3 
end ; 


¥ 1 F 3 B 485 B 


1 - 4 _ 1 -Z 1 



File ’UTILSPIF.r Page 22 
$ page $ 


Updated @ 23:07:52 Sat 27 Sep 1986 


function FIXED_INPUT< PROMPT 

PROMPTSTR ; 

DEFAULT 

longreal 5 

FIELD 

integer 5 

PLACES 

integer ) 


var 


K 

L 

P 

TRIAL_VALUE 

VALUE 

VALUE_APPROVED 

WORK 


integer j 
integer ; 
integer } 
longreal ; 
longreal j 
boolean ; 
LINESTR 5 


begin 

VALUE := DEFAULT , 
SOUND_ALERT ! 


: longreal ) 
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repeat 

WORK :- ” 5 

strurite ( WORK, 1, K, VALUE: FI ELD: PLACES ) 5 
strread < WORK, I, K, VALUE ) ; 

SHOW ( PROMPT+ ’ : ’ ) s 
SET_BRIGHTBLINK_INVERSE_VIDEO ! 

SHOW ( • ’ +W0RK+ ' ’ ) ? 

SE T_NORMAL_ V I DEO 
SHOWLN ( ” ) i 
FETCHLN ( WORK ) s 
M0VE_UP ; 

CLEAR.LINE ; 

MOVE_UP ; 

CLEAR_LINE i 
L := strlen< WORK ) ; 
if L = 0 

then 

VALUE.APPROVED := true 

else 

begin 

VALUE_APPROVED : = false » 
if L > 2 then 
begin 

p : b strposl str( WORK ,2 ,L-1 ) , ’+' ) } 
if p = 0 then 

p := strpos( str( WORK, 2 ,L-1 ) , 
if p > 0 then 

if not ( (UORKIpl-’E* ) or ( WORK[p]=’e’ ) ) then 
6tr insert ( ' E’, WORK, p+1 ) ; 

end ; 

p := strpos( WORK, ) ; 

if p > 0 then 
begin 
if p ■= I 

then strinsert ( ’0’, WORK, 1 ) 
else if p = 2 then 

if ( <W0RKU]»’ + ’ lorlWORKUl"’-’ ) ) then 
strinsert ( ’0’, WORK, 2 ) j 
p := strpos( WORK, > ; 

if p * strlen( WORK ) 

then strappend ( WORK, *0’ > 
else if not ( WORKtp+11 in £ , 0'..'9'1 ) then 
strinsert ( ’0’, WORK, p+1 ) j 

end ; 

try < set trap for possible error } 

strread < WORK, 1, K, TRIAL_VALUE ) j <. error here maybe } 
VALUE := TRIAL_VALUE ; 

SOUND_ALERT j < and jump around "recover" statement > 

recover SOUND_ALARM ; { come here after error, if any > 

end ; 

until VALUE_APPROVED ; 
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SHOW < PRQMPT+' : ' ) 5 
SET_HALFBRIGHT_INVERSE_VIDEO 5 
WORK : » 1 • j 

strurite ( W0RK,1,K,’ ’ , VALUE:FIELD:PLflCES, ’ • ) 5 
SHOW < WORK ) ; 

SET_NORHAL_V I DEO ; 

SHOWLN ( " ) ; 

FIXED_INPUT :=■ VALUE ; 
end ; 


end j < nodule UTILSPIF & File ’UTILSPIF.I’ } 
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< Utility Software Unit for HP-9000 Series 500 with HP-UX 5-0 Op Sys > 
nodule UTILSPIF ; f Subject : System/PASCAL Interface > 

{ NASA/ JSC/MPAD/TRW : San Uilson > 

•C This one nodule contains all of the systen-dependent > 

{ data and PASCAL code needed for nost applications. > 

inport 

UTILMATH ; 


export 

const 


i begin externally visible declarations > 


TICKSPERSEC = 60 ; { Series 500 clock resolution > 


DATELEN - Z4 ; < nunber of characters in date-and-t ine string > 
LINELEN « 80 ; { nax characters in input/output line string > 
NAMELEN = 8 j < nax characters in "nane" string > 
PROMPTLEN - 50 ? < nax characters in pronpt string for user input > 
UORDLEN * 20 } < nax characters in "word” string > 


- 4 . 
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type 

RANDOMINT = 1 . . max int- 1 : £ pseudorandom integer : 1 .. Z 147483646 > 

DATESTR - string £ DATELEN ] 5 

LINESTR = string £ LINELEN ] ; 

NAMEPAC = packed array [ 1..NAMELEN 1 of char : 

NAMESTR = string £ NAMELEN ] ; 

PROMPTSTR - string £ PROMPTLEN ] ; 

UORDSTR = string £ UORDLEN J 5 


CHUAITMODE = < £ describes wait mode for CHAR_INPUT function > 

CHUAIT, £ uait if input buffer is empty > 

NOCHUAIT ) ; £ don’t wait if input buffer is empty > 

CHECHOMOOE = < £ describes echo mode for CHAR_INPUT function > 

CHECHO, £ echo characters back to user terminal screen > 

NQCHECHO ) 5 £ don’t echo characters back to user terminal > 

GOTUHAT - ( { describes result of executing CHAR_INPUT functn > 

NOTHING, < the input buffer was empty (& didn’t uait) } 

ENOOFLINE, < got an end-of-line char ( <RETURN> keystroke) } 

SOMETHING ){ < got a character that was not end-of-line > 

CHINPUTREC = 

record £ returned by the CHAR_INPUT function > 

Q : GOTWHAT ! { qualifier for the returned character > 

C : char ; £ C = ’ ’ if Q = NOTHING or ENDOFLINE; > 

end i £ record > £ else C * char produced by user keystroke } 


var 


LP : text j £ standard file for printed output: must be > 

£ opened by ‘ , ^eu^ite ,, statement somewhere in } 
£ program before use > 
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procedure INITIALIZER ; 

{ This procedure performs the I/O system initialization re- > 

< quired to support most applications. Normally it should he > 

i the first procedure called by any program. > 

procedure CLEAN. UP_IO ; 

{ This procedure closes any open files and generally cleans > 
{ up the I/O system. Normally it should be the last procedure > 

< called by any program. > 

procedure CLEAR.LINE ; 

{ This procedure clears the line on the user terminal where } 

< the cursor is currently located. > 

procedure CLEAR_SCREEN 5 

{ This procedure clears the user terminal screen. > 

procedure FETCHLN ( var STR : LINESTR ) ; 

{ This procedure reads (and thus removes) characters from the > 

{ user terminal input buffer storing them in the string > 

{ variable STR until an end-of-line character (generated > 

f by a <RETURN>* keystroke) has been read. The end-of-line > 

< character is always discarded, along with any other charac- > 

{ ters in excess of the number (LINELEN) needed to fill the } 
{ variable STR to its maximum capacity. > 

< * NOTE: Some keyboards, instead of having a <RETURN> key, > 

{ have an <ENTER> key that serves the same purpose. > 

{ Uherever “<RETURN> H appears in this and following > 

{ descriptions, it should be interpreted as "<RETURN> > 

{ or <ENTER>, whichever is present on the keyboard 1 ’ . > 

procedure LOITER ( MILLISECS : integer ) 5 

< This procedure loops through meaningless code (effectively > 

{ suspending program execution) for the number of milliseconds > 
{ specified in its argument. > 

procedure SUPPRESSJZURSOR ; 

{ This procedure suppresses normal cursor visibility. > 

procedure RESTORE_CURSOR ; 

{ This procedure restores normal cursor visibility. > 
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procedure MQVE.JJP ; 

i This procedure Moves the cursor up one line on the user > 

< terminal. > 

procedure SETJ3RIGHTBLI NK_I NVERSE_V I DEO ; 

{ This procedure causes characters to be written on the user > 

{ terminal screen in the blinking bright inverse video mode, > 

{ which remains in effect until another mode is specified. > 

procedure SET__HALFBRIGHT_INVERSE_VIDEO ; 

{ This procedure causes characters to be written on the user > 

< terminal screen in the halfbright inverse video mode, > 

{ which remains in effect until another mode is specified. > 

procedure SETJ\IORMAL_VIDEQ ; 

{ This procedure causes characters to be written on the user > 

{ terminal screen in the normal video mode, which remains in > 

{ effect until another mode is specified. > 

procedure SHOW ( STR : LINESTR ) ? 

{ This procedure writes a PASCAL string to the user terminal. > 

procedure SHOULN ( STR : LINESTR > ? 

{ This procedure writes a PASCAL string to the user terminal, > 

< and then positions the cursor at the beginning of the next > 

< line. > 

procedure SGUND_ALERT ; 

{ This procedure causes an audible signal to be sounded at the > 
i user terminal, often to indicate that the program is waiting > 
{ for input from the user, sometimes (in real-time simulators) > 
{ to indicate that the program is ignoring an attempted input > 
{ because it is not valid or not capable of timely implementa- > 
{ tion in the current circumstance. > 

procedure SQUND_ALARM ; 

{ This procedure causes a distinctive audible signal to be > 

{ sounded at the user terminal, usually to indicate that some } 

< error condition has occurred that requires corrective action > 

{ on the part of the user. } 


¥6E45F6E5 


1.4. Z -4 


File ’ ut ilspif - 1 ’ Page 5 

$ page $ 


Updated @ 23:09:50 Sat 27 Sep 198G 


procedure STflRT_NEU„PAGE ? 

{ This procedure causes a page-eject character to be written } 
{ to the standard printed-output file LP, which must have been > 
i opened somewhere in the program with a ‘’rewrite" statement- > 

procedure 5TART_RAND0M_NUMBER_SEQUENCE ( SEED : RANDQMINT ) 5 

i This procedure uses the argument SEED to initiate a repeat- > 
{ able sequence of pseudorandom numbers. > 

function RANDOM_I NTEGER : RANDOM I NT ; 

{ This function returns a pseudorandom integer from a uniform > 

< distribution in the range of 1 to MAXINT-1 (i.e., in the > 

< range of I to 2147483646). > 

function CLOCKTICK : integer 5 

{ This function returns an integer corresponding to the number } 

< of "ticks" registered on the system clock since some arbi- > 

< trary fixed time in the past- > 

function CPUTICK : integer ; 

< This function returns an integer number that grows at the > 

< rate of the expenditure of CPU time (measured in system > 

i clock "ticks") to support the calling process. > 

function DATESTRING : DATESTR ; 

{ This function returns a PASCAL string describing the current > 

< date and time in the form, e.g., "17:32:25 Tue 18 Feb 1986", > 

function NAMESTRING ( PAC : NAMEPAC ) : NAMESTR 5 

< This function returns a PASCAL string formed by removing > 

< any blank spaces found in the input PAC (packed array of > 

{ characters ) . > 

function UPPER_CASE( C : char ) : char ; 

< If C is a lower-case letter of the alphabet this function > 

< returns its upper-case counterpart; otherwise it returns > 

{ C unchanged- > 


¥D39Z81DZ 


1 - 4 - Z-5 



File 1 ut i lspif . 1 1 Page G 
$ page $ 


Updated @ Z3:09:50 Sat 11 Sep 1986 


function CAPW0RD( WORD : UORDSTR ) : WORDSTR ; 

{ This function returns a string formed by replacing all > 

{ lower-case letters in the input WORD (if any) with their > 

< upper-case counterparts. > 

function CHAR_INPUT( WMODE : CHWAITMODE ; 

EMODE : CHECHOMODE ) : CHINPUTREC ; 

{ If the user terminal input buffer is empty when this func- > 
{ tion is called, it will will either wait for a character to > 

< be input or return immediately to the calling routine, de- > 

< pending on whether the value of WMODE is CHWAIT or NOCHWAIT. > 

< Whenever it finds the buffer unempty, it removes one char- > 

< acter and if the value of EMODE is CHECHO it echoes that } 

{ character back to the user terminal. If WMODE 33 NOCHWAIT > 

< and the input buffer is empty then the value of CHAR_INPUT„Q } 

< is NOTHING; if an end-of-line character is read from the > 

{ buffer (the result of the user having pressed the <RETURN> > 

< key) then the value of CHAR_INPUT. Q is ENDOFLINE; otherwise > 

< the value of CHAR_INPUT.Q is SOMETHING and the value of > 

{ CHAR_INPUT, C is the character that was read from the buffer. > 
{ CHAR_INPUT.C *= ’ * (the space character) when the value of > 

< CHAR_INPUT.Q is NOTHING or ENDOFLINE. > 

function USER_DECIDES„TO< D0_THI5 : PROMPTSTR ) : boolean ; 

{ The D0_THI5 input string should describe a tentative action, > 
{ and after appending the characters ’ ? 1 it should also form > 
{ a question that can be answered "yes" or "no" by the user > 

< (with a single keystroke, as explained below). The boolean > 

< value of this function is TRUE if the user’s answer is "yes" > 

{ and FALSE if the answer is “no". > 

{ The USER__DECIDES_TG function code causes the D0_THI5 string, > 
{ followed by the characters 1 ? 1 , to be displayed on the > 

i user terminal screen in normal video mode, and then it waits > 

< for the user to press a single key indicating his decision. > 

{ Pressing 1 Y 1 , ’y', or the <RETURN> key indicates "yes". If > 
{ the user presses ’H’.’h’, or ■?* (thinking perhaps to obtain > 
{ a further description of available options), the SQUND_ALARM > 
{ procedure is invoked to give an audible error signal. Any } 
{ other keystroke is interpreted as “no". As soon as an an- } 
{ swer is received, an appropriate character string (’YES’ or > 
{ ’NO 1 ) is displayed in half-bright inverse video mode immed- > 
{ iately behind the prompting question, and the corresponding > 
i boolean value (TRUE or FALSE) is returned to the calling > 

< routine. } 
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function WORD_INPUT< PROMPT : PROMPTSTR ; 

DEFAULT : UORDSTR ) : WORDSTR 3 

< The PROMPT string, folloued by the characters ’ : 1 , is dis- > 

{ played on the user terminal screen in normal video mode and > 

< folloued on the sane line by a display of the DEFAULT value > 

{ in blinking bright inverse video mode, signifying that the > 

{ user may approve the blinking value as shown or else supply > 
{ another value (which will replace the one currently blinking > 
{ and become the new value to be approved or replaced). When > 

{ satisfied with the blinking value, the user terminates the > 

{ input process with a single <RETURN> keystroke (i.e., one > 

{ that is not preceded by any other keystroke). This causes > 

i the display mode of the blinking value to be downgraded to > 

{ steady half-bright inverse video, indicating its acceptance > 
{ by the user. The user-approved value (a character string) > 

< is returned (on the stack) to the calling routine as the > 

< value of the functor WORD^INPUT. } 

< If the PROMPT string does not contain a pair of braces (like > 

{ the ones enclosing each of these comment lines), then the > 
{ user may type in any character string of his choosing, > 

< which must be terminated with a <RETURN> keystroke. After > 

< deleting any leading or trailing blank spaces, and any other } 

{ characters in excess of the number (WORDLEN) required to > 

< fill the INPUT_WORD function value to its maximum capacity, } 
{ the value thus supplied will replace the previous blinking > 

< value on the user terminal screen. This cycle is repeated > 

i until a blinking value is approved in the fashion described > 
{ in the preceding paragraph. > 

{ Braces like the ones enclosing this line if present in > 

{ PROMPT contain a comma-separated list of the only char- > 

{ acter strings that are permissable input values, from which > 

< the user must make a choice. If the blinking value is not } 

{ acceptable to the user, pressing the * - * or the •<• key will > 
{ cause its predecessor in the list to be displayed in the } 

{ blinking mode for possible approvals pressing any other key > 
{ except <RETURN> will cause its successor in the list to be > 
{ displayed instead. Running off the end of the list in } 

{ either direction causes a "wraparound" to the opposite end. > 
i The maximum number of values allowed in the list is ten. > 

function RJWORD_INPUT< PROMPT : PROMPTSTR 3 

DEFAULT : WORDSTR 3 

FIELD : integer 3 

MAXLEN : integer ) : WORDSTR ; 

{ This function works exactly like WORD_INPUT except that the > 
i the user-input "word", when displayed on the user terminal > 

< screen, is r ight- j ust if ied in a space at least FIELD columns > 

i wide, and the length of the "word" is constrained to be no > 
{ greater than MAXLEN. > 
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function INTEGER_INPUT( PROMPT : PROMPTSTR ? 

DEFAULT : integer ; 

FIELD : integer ) : integer ; 

<■ This function works very Much like RJWORD_INPUT except of > 
{ course the function value is an integer instead of a string, > 
{ which Makes the MAXLEN arguMent of RJUORO_INPUT inappropri- 1 

< ate in this case. If the user types in a nuMber in fixed- > 
{. point deciMal format, it is truncated to Make it an integer } 
f (i.e., the decimal point and any characters following it are > 

< ignored). Any attempt on the part of the user to input a > 

< non-nuneric value causes an audible error signal to be pro- } 

< duced by the SOUNO_ALARM procedure, and the blinking value > 

< remains unchanged. > 

function FIXED_INPUT< PROMPT : PROMPTSTR j 

DEFAULT : longreal ; 

FIELD : integer ; 

PLACES : integer ) : longreal j 

{ This function is similar to INTEGER_INPUT except that the 1 
{ function value is a longreal number instead of an integer. > 
•C A fixed-point format is always used to display the function } 

< value on the user terminal screen, and the PLACES argument } 

< specifies how many digits are to be shown after the decimal > 

{ point. If the user types in a number with more digits than } 
i what is called for by the PLACES argument, it is rounded to > 
{ the nearest decimal digit in the last place shown on the > 

< screen. The same applies to the DEFAULT value supplied } 

{ by the calling routine. Uithin the limits of precision that > 

< are inherent in the transformation between the binary and } 

< the decimal representation of a number, the function value } 

{ returned to the calling routine is exactly that which is } 

{ shown to the user, with no significant decimal digits lurk- > 
{ ing unseen beyond the last one displayed (i.e., "what you } 
{ see is what you get"). > 

■C This function does not require user input to be typed in a } 
{ fixed-point format. Integer format is acceptable for whole > 
{ numbers, and it is not necessary to type "0" before the dec- } 
f imal point of a fraction nor behind that of a whole number. } 
{ An exponential format may be used if that is the user’s > 

{ preference. For example, the value displayed on the user } 

< terminal screen and returned to the calling routine } 

-C as "150.00" may have been typed in by the user as "149.996", } 

< "150", "150.", “1.5+Z”, " 1 . 5e2" , or " 1 .499963L2" . If the > 

C user attempts to input a non-numeric value, FIXED_INPUT will > 
{ call the SOUND_ALARM procedure to produce an audible error } 
{ signal, and the blinking value will remain unchanged. } 


¥C6EABBAA 


1 . 4 . Z- 8 



File ’utilspif . I ’ Page 9 Updated & Z 3 : 09:50 Sat Z 7 Sep 198 G 

$ page $ 

implement { begin externally invisible part of module > 

const 


DATEPACLEN - 

26 3 



FORMFEED *= 

chr( 

01Z 

) ; 

NEULINE 

chr( 

010 

) i 

NULLCHAR = 

chr( 

000 

) ; 


type 

DATEPAC * packed array C 1 . . DATEPACLEN ] of char 3 
DATEPTR = A DATEPAC ; 

PAC 25 G « packed array t I -.256 ] of char 3 
TMSREC - 
record 

UTIME : integer ; 

5 TIME : integer ; 

CUTIME : integer ; 

CSTIME : integer 3 
end 3 < record > 

var 

RANDOMSEED : RANDOM! NT ; 


{ HP-UX 5.0 system routines called from this module: 


> 


function ctime 
function times 
procedure exit 
procedure time 

{ C routines (defined in 


< var SECONDS : integer 

( var TMS : TMSREC 

( STATUS : integer 

( var SECONDS : integer 


) : DATEPTR ; external ; 

) : integer 3 external ; 

> ; external ; 

> ; external ; 


’utilscif -c* ) called from this module: 


procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

procedure 

function 


clearl ine 
clearscreen 

fetchpac ( var PAC : PAC 256 ) 

ioinit ial ize 

iouninitial ize 

moveuptrou 

restorecursor 

setbrightblinki 

setcbreak 

setcecho 

setcuait 

sethalf bright i 

setnocbreak 

setnocecho 

setnocuait 

setnormal video 

shoupac < var PAC : PAC 256 ) 

soundalert 

suppresscursor 

kbdcharcode 


integer 


; external 3 
3 external 5 
3 external 3 
5 external ; 
5 external 3 
3 external ; 
3 external ; 
; external 3 
3 external 3 
5 external 3 
3 external 3 
3 external 3 
3 external 5 
; external 3 
5 external 3 
3 external 3 
3 external 5 
3 external 3 
3 external 3 
3 external 3 
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procedure INITIALIZE_IO 3 
begin 

ioinitialize ; 

RANDQMSEED : = IMflX( 1, IMIN( naxint-1 
end ; 


procedure CLEANJJP_IO ; 
begin 

RESTORE^CURSOR ; 
iouninitialize ; 
end ; 


procedure CLEAR_LINE ; 
begin 

clearline ? 
end ; 


procedure CLEAR_SCREEN ; 
begin 

clearscreen ; 
end ; 


procedure FETCHLN ( var STR : LINESTR ) ; 
var 


i : integer ; 
WORK : PACZ56 3 


begin 

fetchpac ( WORK > ; 
setstrlen( STR, 0 ) \ 
i 0 3 
repeat 

i :* i + 1 3 

if UORKCil <> NULLCHAR then 


begin 

setstrlen < STR, i ) ; 

STRtil :* UORKCi] ; 
end 3 

until ( WORKEiJ - NULLCHAR ) or ( 


end ; 


, CLOCKTICK ) ) ; 


i - LINELEN > 3 
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procedure LOITER ( MILLISECS : integer ) ; 
var 

TICK : integer ; 

TMS : TMSREC 5 
TOCK : integer ; 

begin 

TOCK :=* t imes( TMS ) + ( TICKSPERSEC * MILLISECS ) div 1000 j 
repeat 

TICK := times( TMS ) ; 
until TICK > TOCK ; 

end ; 


procedure SUPPRESS_CURSOR ; 
begin 

suppresscursor ; 
end ; 


procedure RESTGRE_CURSOR ; 
begin 

restorecursor ; 
end ; 


procedure MOVE_UP 5 
begin 

rooveuplroui ; 
end ; 


procedure SET^BRIGHTBLINK _INVERSE_VIDEO ; 


begin 

setbr ightbl ink i j 
end 5 


procedure SET_HALFBRIGHT_INVERSE_VIDEO ; 
begin 

sethalf bright i ; 
end 5 


procedure SET_NORMAL_VIDEO ; 
begin 

setnormal video ; 
end ; 
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procedure SHOW < STR : LINESTR ) ; 
var 

i : integer 3 
n : integer 3 
WORK : PACZ5G i 

begin 

n strlen( STR ) 3 
if n > 0 then 

for i s» 1 to n do 

UORKU] := STR[ i ] ; 
WORK C n+ 1 ] := NULLCHAR 5 
shoupac ( WORK ) ; 
end 3 


procedure SHOWLN ( STR s LINESTR ) ; 
var 

i : integer 5 
n : integer 3 
WORK : PACZ56 3 


begin 

n :* strlen( STR ) 3 
if n > 0 then 

for i :* I to n do 

WORK C i ] STRCiJ ; 

WORKIn+11 := NEWLINE 3 
UORKtn+Zl 2 * NULLCHAR 3 
shoupac ( WORK ) 5 
end 3 


procedure SOUND_ALERT 3 
begin 

soundalert ; 
end 3 


procedure SOUND_ALARM 3 


begin 

SOUND.ALERT 5 
LOITER ( 400 ) 3 
SGUND_ALERT 3 
LOITER < Z00 ) ; 
SQUND_ALERT ; 
end 3 
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procedure START_NEW_PAGE ; 
begin 

write ( LP, FORMFEED ) i 
end ; 


procedure START_RANOOM_NUMBER_SEQUENCE ( SEED : RANDOMINT ) 5 
begin 

RANDOMSEED := SEED 5 
end ; 


function RAND0M_I NTEGER : RANDOMINT ; 

begin < emulation of Series 200 pseudorandom number generator > 
RANDOMSEED :« trunc( RM0D( < RANDOMSEED « 16807L0 ), maxint ) ) 5 
RANDOM, I NTEGER := RANDOMSEED 5 
end 5 


function CLOCKTICK : integer 5 
var 


TMS : TMSREC i 

begin 

CLOCKTICK :» times< TMS ) 5 
end ; 


function CPUTICK : integer ; 


var 


TMS : TMSREC ; 
TRASH : integer ; 


begin 

TRASH := times( TMS ) ; 
with TMS do 

CPUTICK := UTIME + STIME + CUTIME + CSTIME s 

end ; 
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function DATESTRING : DATESTR ; 


var 


begin 
tine 
POINTER : * 


i : 

integer 

POINTER : 

DATEPTR 

SECONDS : 

integer 

WORK : 

DATESTR 

1 

( SECONDS 

) 5 


setstrlen 
for i : = 
i : = 
i 

i : = 
i 


for 

for 

for 

for 


( 

1 

10 

14 

17 

Z1 


ct ime( 
WORK, 
to 9 


to 

to 

to 

to 


if UORKt I4J 
DATESTRING 
end ; 


13 
1 G 
Z0 
Z4 

V 9 

WORK 


SECONDS > 
DATELEN ) 
do WORK [ i J 
do WORKIiJ 
do WORK [ i ] 
do WORK! i ] 
do WORK I i ] 
then WORK t 14] 
; 


POINTERS i+11) 
POINTERS i- 91 
POINTER"! i- 51 
POINTER"! i- 1 Z 1 
POINTER"! i ] 
:= ’ 0 ’ 


function NAMESTRING ( PAC : NAMEPAC > : NAMESTR 5 
var 


i : integer ; 
n : integer ; 
WORK : NAMESTR ; 


begin 

setstrlen! WORK, NAMELEN ) ; 
n :*= 0 ; 

for i 1 to NAMELEN do 

if PACIi] <> ’ ’ then 
begin 

n : * n + 1 ; 

WORKIn] := PACIi I j 
end } 

aetatrlen ( WORK, n ) i 
NAMESTRING := WORK ; 
end ; 
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Function UPPER_CASE< C : char ) : char i 
var 


K : integer j 


begin 

K := ord( C ) ; 

if K >= ord( ’a’ ) then 

if K <= ord< ’z’ ) then 

C := chr( K + ord( ’A’ ) - ord( ’a’ ) ) ; 
UPPERCASE := C } 
end ; 


function CAPU0RD< WORD : UORDSTR ) : UIORDSTR ; 
var 


i : integer j 
n : integer ; 


begin 

n :* strlen< UORD ) j 
if n > 0 then 

for i : * 1 to n do 

WORDf i ] := UPPER_CASE( UORDIil ) ,• 
CAP UORD :■= UORD ? 
end ; 
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function CHAR_1NPUT< UMODE : CHUAITMODE ? 

EMODE : CHECHOMODE ) 


var 


K : integer i 
WORK : CHINPUTREC ; 


begin 

setcbreak ; 

if EMODE - NOCHECHO then 
setnocecho \ 

if UMODE ■= NOCHURIT then 
setnocuait ; 

K := kbdcharcode ; 

if ( UMODE = NOCHUflIT) and ( K = -1 

then 

begin 

WORK.Q :> NOTHING , 

UORK.C ? 

end 


else 

begin 

UORK.C := chr( K ) ; 
if UORK.C - NEULINE 

then 

begin 

UORK.Q := ENDOFLINE i 
UORK.C := ' ' ; 
end 


else 

WORK.Q := SOMETHING i 


end 5 

setcuait ; 
setcecho ; 
setnocbreak ; 
CHAR_INPUT :■= UORK j 
end ; 


: CHINPUTREC s 
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function USER_OECIDES_TQ< D0_THIS : PROMPTSTR > : boolean 5 


var 


ANSWER : string! 3 ] 

OKAY : boolean 

WORK : CHINPUTREC 


begin 

SOUND_ALERT 1 
repeat 

SHOW ( D0_THIS+ ’ ? • ) 5 

WORK :■= CHAR_INPUT( CHWAIT, NOCHECHO ) ; 

OKAY := true ; 

if WORK . Q = ENDOFLINE 

then ANSWER := 'YES’ 

else 

begin 

case WORK . C of 
’ Y' , ’ y ’ : 

ANSWER := 'YES’ : 

’H’.’h’,’?’: 

begin 

OKAY := false ; 

SOUND. ALARM ; 
end 5 

otherwise 
ANSWER := 'NO' s 


end ; { case WORK.C > 

end j 

CLEAR_LINE ; 
until OKAY ; 

SHOW ( DO_THIS+ ’ ? • ) j 
SET_HALFBRIGHT_INVERSE_VIDEO s 
SHOW < • ’+ANSWER+’ ’ ) ! 

SET_N0RMAL_V I DEO 5 
SHOWLN ( ” > 5 
if ANSWER - ’NO’ 

then USER_DECIDES_TO < D0_THIS > := false 
else USER_DECIDES_TO { D0_THIS > := true ; 

end 5 
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function WORO_INPUT< PROMPT : PROMPTSTR ; 

DEFAULT : WORDSTR ) : WORDSTR ; 

begin 

WORD_INPUT : = RJWORD_INPUT< PROMPT, DEFAULT, 0, UORDLEN ) 5 
end ; 


function RJUORD_INPUT< PROMPT 

DEFAULT 

FIELD 

MAXLEN 


PROMPTSTR ; 

WORDSTR ; 
integer j 

integer ) : WORDSTR s 


var 


base 

integer ; 

current 

integer ; 

DELIM 

integer 3 

FLD 

integer 3 

K 

integer 3 

LBRACE 

integer ; 

LEN 

integer ; 

OPTION 

array [ 0..3 ] of UORDSTR 3 

RBRACE 

integer 3 

SELECT_MODE 

boolean 5 

VALUE 

WORDSTR 5 

VALUE_APPROVED 

boolean 5 

WERK 

CHINPUTREC 5 

WIRK 

LINESTR ; 

WORK 

LINESTR ; 
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begin C function RJWORD_INPUT > 

MAXLEN := IMIN( UIOROLEN, MAXLEN ) 5 
WORK :« strltrim! strrtrin! DEFAULT ) ) 5 
LEN := IMIN! MAXLEN, strlen( WORK ) ) 5 
DEFAULT := str( WORK, 1 , LEN ) ; 

SELECT_MODE := false , 

LBRACE := strpos( PROMPT, ) ; 

if LBRACE > 0 then 
begin 

RBRACE := strpos( PROMPT, ’ >* ) ; 
if RBRACE > LBRACE then 
begin 

SELECT_MODE := true i 
base := 0 ; 

LEN := RBRACE - LBRACE ; 

WORK := str( PROMPT, LBRACE+ 1 , LEN ) 5 
repeat 

DELIM := strpos! WORK, ’ ,’ > 5 
if DELIM = 0 then 

DELIM := strpos< WORK, ’ >’ ) 5 
LEN := DELIM - 1 ; 

WIRK := strltrin! strrtrim! str( WORK, 1, LEN ) ) ) 5 
LEN := IMIN( MAXLEN, strlen( WIRK ) ) 1 
OPTION! base] := str( WIRK, 1 , LEN ) j 
strdelete! WORK, 1, DELIM ) 5 
base := base + 1 j 
until strlen( WORK ) = 0 ; 
current := base 5 
repeat 

current := current - 1 ; 

until ! OPTI ON! current ] = DEFAULT ) or ( current = 0 ) 5 
DEFAULT := OPTION! current ] ; 
end ; 

end ; 

VALUE := DEFAULT ; 

50UND_ALERT ; 
repeat 

SHOW < PR0MPT+’ : 1 ) 5 
SET_BRIGHTBLINK_INVERSE_VIDEO 5 
FLD := I MAX! FIELD, strlen! VALUE ) ) j 
WORK := •• ; 

strurite < W0RK,1,K,’ ’ ,VALUE:FLD , ' ’ ) 5 
SHOW < WORK ) i 
SET_,NORMAL_V I DEO j 
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if SELECT.MODE 

then 

begin 

WERK := CHAR_INPUT( CHWAIT, NOCHECHO ) 3 
if UERK.Q = ENDOFLINE 

then VALUE_APPROVED :« true 

else 

begin 

VALUE_APPRQVED := false 3 
if WERK . C in t •<• ] 

then current := < current - 1 > nod base 
else current := { current + 1 ) nod base ; 
VALUE := OPTION! current] 3 
end ; 

CLEAR_LINE 3 
end 


else 

begin 

SHOULN ( ” ) 5 
FETCHLN < WORK ) 3 
M0VE_UP 3 
CLEAR_LINE 3 
M0VE_UP 3 
CLEAR_LINE ; 
if strlen< WORK ) = 0 


then VALUE APPROVED := true 


else 

begin 

VALUE_APPROVED := false 3 

WORK :■ strltrin( strrtrin( WORK ) ) ; 

LEN :» strlen( WORK > 3 

if LEN > MAXLEN 


then 

begin 

LEN :» MAXLEN 3 
SOUND_ALARM 3 
end 

else SOUND_ALERT ; 

VALUE := str< WORK, 1 , LEN ) ; 
end ; 


end ; 

until VALUE_APPROVED 3 

SHOW ( PR0MPT+ ’ : ’ ) 3 
SET_HALFBRI6HT_INVERSE_VIDE0 3 
WORK :» ” 5 
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strwrite ( UORKJ.K,’ • , VALUE:FLD, • » ) ; 
SHOW ( WORK ) ; 

SET_NORMAL_VI DEO s 
SHOULN ( ” ) ; 

RJWORD_INPUT := VALUE } 

end j < function RJWORD_INPUT > 
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function INTEGER_INPUT< PROMPT : PROMPTSTR j 

DEFAULT : integer ? 

FIELD : integer ) : integer 5 


var 


K : integer 
TRIAL.VALUE : integer 
VALUE : integer 
VALUE. APPROVED : boolean 
WORK : LINESTR 


begin 

VALUE := DEFAULT ; 

SOUND. ALERT 5 
repeat 

SHOW ( PROMPT+’ : ’ ) ; 
SET.BRIGHTBLINK.INVERSE.VIDEO 5 
WORK := ” 5 

strurite ( UORK.1.K,’ ’ , VALUE:FIELD, ’ ’ > j 
SHOW < WORK ) ; 

SET.NORMAL.VIOEO \ 

SHOULN ( ” ) s 
FETCHLN ( WORK ) j 
MOVE.UP 5 
CLEAR.LINE ; 

MOVE.UP 5 
CLEAR_LINE ; 
if strlen( WORK ) =■ 0 


then 

VALUE.APPROVED : - true 


else 

begin 

VALUE.APPROVED :- false s 

try { set trap for possible error > 

strread < WORK, 1, K, TRIAL.VALUE ) ; { error here maybe } 

VALUE := TRIAL.VALUE i 

SOUND.ALERT ; I and jump around “recover" statement 1 

recover SOUND.ALARM ; { come here after error, if any 1 

end ; 

until VALUE.APPROVED 5 
SHOW ( PR0MPT+’ : • ) 5 
SET.HALFBRIGHT.I NVERSE.VI DEO s 
WORK » 

strurite ( W0RK.1.K,’ ’ , VALUE : FIELD, ’ • > 5 
SHOW ( WORK ) ! 

SET.NORMAL.V I DEO 5 
SHOULN ( ’ ’ ) i 
INTEGER.INPUT := VALUE ; 
end 3 
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function FIXED_INPUT< PROMPT : PROMPTSTR 5 

DEFAULT : longreal ; 
FIELD : integer i 
PLACES : integer ) 


var 


K 

L 

P 

TRIAL. VALUE 
VALUE 

VALUE. APPROVED 
WORK 


integer ; 
integer ; 
integer ; 
longreal ; 
longreal 5 
boolean ; 
LINESTR ? 


begin 

VALUE := DEFAULT ; 
SOUND.ALERT 5 


: longreal ; 
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repeat 

WORK := ” s 

strurite ( WORK, 1, K, VALUE : FI ELD: PLACES ) 5 
strread ( WORK, 1, K, VALUE ) ? 

SHOW ( PR0MPT+ ’ : ’ ) 5 
SET_BRI GHTBL I NK_ I NVERSE_ VI DEO , 

SHOW ( 1 ’ +W0RK+ ’ • ) ; 

SET_NQRMAL_VIDEQ » 

SHOWLN ( " ) ; 

FETCHLN ( WORK ) s 
MOVEJJP ; 

CLEAR_LINE ; 

MOVEJJP j 
CLEAR_LINE » 

L := strlen( WORK > 5 
if L = 0 

then 

VALUE_APPROVED :« true 

else 

begin 

VALUE_APPRQVED := false , 
if L > Z then 
begin 

p := strpos( str( WORK ,L -1 ) , ’ + ’ ) ; 
if p = 0 then 

p := strpos( str( WORK ,Z ,L- 1 ) , ) ; 

if p > 0 then 

if not ( ( WORK! p] = ’ E’ ) or < WORK! p] = ’ e’ ) ) then 
strinsert ( ’E* , WORK, p+1 ) ; 

end j 

p := strposl WORK, ) ; 

if p > 0 then 
begin 
if p = 1 

then strinsert ( ’0’, WORK, 1 ) 
else if p = Z then 

if ( (WORK! 1] = ’ + ’ >or(W0RK[ 1]=’-’ ) > then 
strinsert ( *0', WORK, Z ) ; 
p :» strpos( WORK, • . • > ; 
if p = strlenl WORK ) 

then strappend ( WORK, ’0’ ) 
else if not ( WORKIp+11 in [’©’..’S’] ) then 
strinsert ( ’0’, WORK, p+1 ) ; 

end ; 

try { set trap for possible error 1 

strread ( WORK, 1 , K, TRIAL_VALUE ) ; { error here maybe } 

VALUE := TRIAL_VALUE i 

SOUND_ALERT ; 1 and jump around "recover" statement }• 

recover SOUND_ALARM ; { come here after error, if any } 

end ; 

until VALUE_APPROVED i 


¥B45CFFDC 


1 - Z-Z4 



File ’utilspif.I’ Page 25 
$ page $ 


Updated @ 23:09:50 Sat 27 Sep 1986 


SHOW ( PR0MPT+* : ’ > 3 
SET_HALFBRIGHT_INVERSE_VIDEO 5 
WORK := " ? 

strurite ( WORK.I.K,’ ’ , VALUE:FIELD:PLACES, ’ ’ ) 5 
SHOW ( WORK ) i 
SE T_NORMAL_V I DEO s 
SHOWLN ( ” ) ; 

FIXED_I NPUT := VALUE 3 
end ; 


end 3 { module UTILSPIF & File ’utilspif.I' > 


. 4 . 
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■( Utility Software Unit for HP-9000 Series 200/300/500 Computers } 

nodule UTILVEMQ 5 { Subject : Vectors, Euler angles, matrices, quaternions } 

f NASA/ JSC/ MP AD/ TRW : Sam Wilson > 


import 


UTILMATH 

UTILSPIF 


export 

type 


{ begin externally visible declarations } 


EULARR = 

array [ 1..3 ] of longreal 


EULPRY 

EULPYR 

EULRPR 

EULYRY 


EULARR 

EULARR 

EULARR 

EULARR 


{ a generic triad of Euler angles > 
{ representing three sequential > 
{ rotations of a rigid body about > 

< orthogonal axes fixed in the } 

{ body itself: 1 

< X axis = 1 = R = ROL > 

< Y axis = 2 = P * PCH > 

< Z axis » 3 = Y - YAW . > 

< The array is indexed according > 

< to the rotation number, NOT the } 

< axis number. > 

Euler angles for a PCH/ROL/YAW sequence > 
Euler angles for a PCH/YAU/ROL sequence } 
Euler angles for a ROL/PCH/ROL sequence > 
Euler angles for a YAW/ROL/YAW sequence > 


VECTOR = 

array ( 1..3 ] of longreal 


MAT3X3 = 

array t 1..3 ] of VECTOR 


DIAG3X3 = 

array l' 1..3 ] of longreal 


SYMM3X3 = 

array E 1..6 3 of longreal 


< a row matrix of vector compon- } 
{ ents in a right-handed Carte- > 
{ sian coordinate system. Index } 
{ = coordinate axis number ( phys- > 

< ically) = matrix column number } 

{ (mathematically). > 

< a 3x3 matrix. The element in > 
{ the ith row and the jth column > 
{ of matrix M can be addressed as } 
{ Mti,j3. The ith row (a vector) } 

< can be addressed as M[ i 1 . } 

i the elements of a diagonal 3x3 > 

< matrix h, stored in the order: } 

{ MI1.13 , ME 2 ,2 3 , ME 3 , 33 . > 

{ the elements of a symmetric 3x3 } 
{ matrix M, stored in the order: > 

{ ME 1,1 3 , } 

<. ME 2 , 1 1 , ME 2 ,23 , > 

f ME 3, 1 1 , ME 3,23 , ME3.31 . > 
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QUATERNION * 
record 

case boolean of 
false : ( 


true 


end 


( 


longreal 

VECTOR 

longreal 

longreal 

longreal 

longreal 


{ case and record > 


{ a record containing the sea- > 
f lar and the vector parts of > 
f a quaternion. The scalar > 

< part of the quaternion Q can > 
{ be addressed as Q.S or Q.H, > 
t and the vector part can be > 
i addressed as Q.V . The in- > 
i dividual components of the > 
{ the vector part can be ad- > 

< dressed as Q.VM3, Q.VI2J, > 

< Q. VC 31 or as Q.I, Q.J, Q.K . > 


const 


ZERVEC = VECTOR 

I 

ZERO, 

ZERO, 

ZERO ] ; 



{ zero 

vector 

> 

XUNVEC = VECTOR 

l 

ONE, 

ZERO, 

ZERO ] 5 

< 

unit 

vector , 

axis 1 

> 

YUNVEC = VECTOR 

l 

ZERO, 

ONE, 

ZERO J ; 

{ 

unit 

vector , 

axis 2 

> 

ZUNVEC = VECTOR 

[ 

ZERO, 

ZERO, 

ONE J j 

{ 

unit 

vector. 

axis 3 

> 

ZER3X3 - MAT3X3 

[ 





{ 

3x3 zero 

matrix 

> 


ZERVEC , 
ZERVEC , 
ZERVEC ] ; 


IDN3X3 = MAT3X3 C { 3x3 identity matrix > 

XUNVEC , 

YUNVEC , 

ZUNVEC ] ; 


function EULDEG( E : EULARR ) : EULARR ; 


< EULDEG converts a triad of Euler angles from radian measure } 
{ to degrees. It is normally used to convert internal values > 
{ to measurement units suitable for output. This function is > 
{ unique in that angles output by every other routine in this > 
{ module are measured in radians. > 


function EULRAD< E s EULARR ) : EULARR ; 

{ This function converts a triad of Euler angles from degree } 

< measure to radians. It is normally used to convert external > 

i values supplied by the user to measurement units suitable > 

{for internal computations. EULRAD is unique in that the > 

■( input angles must of course be measured in degrees, uhereas > 

< angles input to every other routine defined in this module > 

< must be measured in radians. > 


function D0TP< V , U : VECTOR ) : longreal ; 

< The value of this function is the dot (scalar) product of > 
{ the vectors V and U. > 
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function VMAG< V : VECTOR > : longreal ; 

< The value of this function is the scalar magnitude of the > 

{ vector V. > 

function SXV< S : longreal ; V : VECTOR ) : VECTOR ; 

< The value of this function is the product of the scalar S > 

{ and the vector V. > 

function CRSP( V , W : VECTOR ) : VECTOR ; 

{ The value of this function is the cross product of the vec- > 

i tors V and W; i.e., CRSP(V,U) * V x W . > 

function VDIF( V , U : VECTOR ) : VECTOR 5 

{ The value of this function is the difference of the vectors > 

< V and U; i.e., VDIF(V.U) - V - U . > 

function VSUM< V , U : VECTOR > : VECTOR ; 

< The value of this function is the sum of the vectors > 

< V and U. } 

function VXD< V s VECTOR ; D s DIAG3X3 ) : VECTOR ; 

i The value of this function is the product of the vector > 

{ (rou matrix) V and the diagonal matrix D. That is to say, > 

i VXD(V,D) = V * M, where '* * '* represents the matrix multipli- > 

{ cation operator and M represents D in its full 3x3 form. > 

function VXM< V : VECTOR ; M s MAT3X3 ) : VECTOR ; 

< The value of this function is the product of the vector > 

{ (rou matrix) V and the matrix M, i.e., VXM(V,M) = V * M, } 

{ where represents the matrix multiplication operator. > 

function VXMT( V : VECTOR 5 M : MAT3X3 ) : VECTOR ; 

{ The value of this function is the product of the vector > 

i (rou matrix) V and the transpose of the matrix M, i.e., > 

{ VXMT(V,M) = V * T, where “*'* represents the matrix multi- > 

{ plication operator and T is the transpose of M. > 
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function MDIF< L , M : MAT3X3 ) : MAT3X3 s 

{ The value of this function is the difference of the Matrices } 

< L and Ms i.e., MDIF(L,M> * L - M . > 

function MSUM( L , M : MAT3X3 ) : MAT3X3 s 

< The value of this function is the sun of the matrices } 

< L and M. > 

function MXM< L , M : MAT3X3 ) : MAT3X3 s 

< The value of this function is the product of the matrices > 

■C L and Ms i.e., MXM(L,M) = L * M , uhere represents the > 
{ matrix multiplication operator. } 

function MXMT< L , M : MAT3X3 > : MAT3X3 s 

<■ The value of this function is the product of the matrix L > 

-C uith the transpose of the matrix Ms i.e., MXMT(L.M) - L * T, } 

f uhere represents the matrix multiplication operator and 1 

< T is the transpose of M. > 

function MTXM( L , M : MAT3X3 ) : MAT3X3 5 

{ The value of this function is the product of the transpose > 

i of the matrix L uith the matrix Ms i.e., MTXM(L,M) «* T * M, } 

T uhere represents the matrix multiplication operator and } 
f T is the transpose of L. > 

function MINV< M : MAT3X3 ) : MAT3X3 s 

{ The value of this function is the inverse of the matrix M, > 

■C uhich is computed by the INVERT_MATRIX procedure of module } 

{ UTILMATH. INVERT_MATRIX uill abort program execution uith } 

f an escapecode of 9901 if M is singular, and the value of } 

< MINV uill be undefined. The reference to MINV should be } 

< embedded in a "try/recover" construct if it is desired to > 

{ provide exception-handling code in the calling routine to } 

{ recover from such an eventuality. > 
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function IMATQ( T : MAT3X3 ) : QUATERNION s 

< Given the inverse (which is equal to the transpose T) of the 1 

{ orthogonal matrix that transforms vector components from one } 
{ Cartesian coordinate system F to another Cartesian system G, 1 
{ this function computes a quaternion describing an eigenaxis > 
{ rotation which (assuming the two systems to have a common } 

{ origin) would rotate the axes of system F into coincidence 1 

{ with the axes of system G, and returns that quaternion to > 
{ the calling routine as the value of IMATQ. 

< This function is particularly useful for establishing the > 

< angular relationship between a fixed reference system and > 

< another system whose axes can be described in terms of unit > 

i vectors in the reference frame. For instance, if POS_J and } 

< VEL_J are the position and velocity vectors of a satellite } 

i in the Mean of 1950.0 geocentric inertial system J, the U } 

{ and U axes of the satellite-centered UVUI coordinate system > 
{ are parallel to PQS_J and P0S_J x VEL_J, respectively. The > 

< angular orientation of the UVU system H is defined with re- > 

< spect to J by the quaternion QJH, which can be determined by > 

■C the following sequence of statements that also determine MHJ > 
{ (the matrix that transforms vector components from system H } 
{ to system J). > 

< > 

< ANGMOM_J := CRSP< P0S_J, VEL_J ) ; > 

•C MHJf 3] := SXV< ONE/VMAG( ANGM0M_J ), ANGM0M_J ) ? } 

{ MHJIl] := SXV( 0NE/VMAG( POS_J ), POS_J ) j } 

< MHJf Z 1 := CRSP( MHJf 3], MHJf 1 ] ) ; > 

{ QJH := IMATQ( MHJ ) 5 > 

<■ } 

< If the input matrix fails an orthogonality test based on the > 

f value of UNITOL (see module UTILMATH) then this routine will > 
f abort program execution with an escapecode of 9701, and the } 
i value of IMATQ will be undefined. The reference to IMATQ } 
f should be embedded in a "try/recover" construct if it is 1 

i desired to provide exception-handling code in the calling } 

< routine to recover from such an eventuality. } 
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function 


function 


function 


function 


PRYQ< PRY : EULPRY ) : QUATERNION ? 


f The value of this function is a quaternion that describes an > 
{ eigenaxis rotation (i.e., a single rotation of a rigid body > 
{ about one suitably chosen axis) which has the same final > 

< effect as the sequence of rotations defined by the input > 

i values of the PCH/ROL/YAU Euler angles. > 

t The vector part of the output quaternion is referenced to > 
{ axes fixed in the rigid body, and it points in the direction > 
{ of the eigenaxis rotation (i.e., in the direction that a > 

{ right-hand screw would travel linearly during a positive > 

{ rotation about the eigenaxis). The scalar part is equal to > 

< cos( A/2 ) and the magnitude of the vector part is equal to > 

{ sin< A/2 ), where A is the angle of rotation about the > 

i eigenaxis. Thus it can be seen that the sum of the squares > 

{ of the components of any quaternion used to define the ori- > 

< entation of a rigid body must be equal to 1.0 (unity). Such > 

{ a quaternion is said to be “normal ized" and is sometimes > 

< referred to as a "versor" , but more often it is called a > 

< "unit quaternion". > 


< When the "rigid body" is an imagined set of Cartesian axes } 

{ that is rotated about its origin from a state of coincidince > 

< with the axes of one fixed reference system into a state of } 
( coincidence with the axes of another fixed reference system, > 

< it follows from the preceding paragraph that all components } 

{ of the quaternion including the components of its vector > 

{ part have identical values in both of the fixed systems. > 

{ Furthermore, the quaternion that describes the inverse rota- > 
{ tion (from the second fixed system to the first) can be ob- > 
{ tained simply by reversing the sign on all components of the > 

< vector part or, alternatively, by changing the sign of > 

{ the scalar part and leaving the vector part unchanged. > 


PYRQ( PYR : EULPYR ) : QUATERNION ; 

{ This function is identical to PRYQ except that the Euler > 

< rotation sequence is PCH/YAU/ROL instead of PCH/ROL/YAU. > 


RPRQ< RPR : EULRPR ) : QUATERNION ; 

{ This function is identical to PRYQ except that the Euler > 

{ rotation sequence is ROL/PCH/ROL instead of PCH/ROL/YAU. > 


YRYQ( YRY : EULYRY ) : QUATERNION ; 

{ This function is identical to PRYQ except that the Euler > 

{ rotation sequence is YAU/ROL/YAU instead of PCH/ROL/YAU. > 


C ' 


?r- 
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function QPRY< Q : QUATERNION ) : EULPRY ? 

{ The value of this function is a triad of Euler angles for a > 

< PCH/ROL/YAW rotation sequence having the sane final effect > 

•t as that of the eigenaxis rotation uhich is defined by the } 
f unit quaternion Q. }. 

function QPYR( Q : QUATERNION ) : EULPYR j 

< The value of this function is a triad of Euler angles for a } 
{ PCH/YAU/ROL rotation sequence having the sane final effect } 
{ as that of the eigenaxis rotation uhich is defined by the } 

< unit quaternion Q. > 

function QRPR< Q : QUATERNION ) : EULRPR ; 

{ The value of this function is a triad of Euler angles for a > 
{ ROL/PCH/ROL rotation sequence having the sane final effect } 
{ as that of the eigenaxis rotation uhich is defined by the } 
i unit quaternion Q. > 

function QYRY( Q : QUATERNION ) : EULYRY ; 

{ The value of this function is a triad of Euler angles for a > 
f YAU/RQL/YAU rotation sequence having the sane final effect } 

< as that of the eigenaxis rotation uhich is defined by the > 

{ unit quaternion Q. > 

function QMAT< Q : QUATERNION ) : MAT3X3 5 

{ Given a unit quaternion Q describing an eigenaxis rotation } 

< uhich (assuning coincidence of origins) uill rotate the axes > 

< of Cartesian systen F into coincidence uith the axes of sys- } 

< ten G, this routine conputes the natrix M that transforns > 
{ vector conponents fron systen F to systen G, and returns it > 

< to the calling routine as the value of the function QMAT. > 
{ For instance, if VEC_F is referenced to systen F and VEC_G } 
•C is the physically identical vector referenced to systen G, } 
{ then VECJ3 - VXM< VEC_F, QMAT< QFG ) ), uhere QFG is a qua- > 

< ternion that defines an eigenaxis rotation fron F to G. } 

{ If the sun of the squares of the conponents of the input > 

{ quaternion differs fron unity by nore than UNITOL < see nod- } 
f ule UTILMATH) then this routine uill abort progran execution > 
f uith an escapecode of 9702, and the value of QMAT uill be } 

{ undefined. If it is desired to provide exception-handling 1 

< code in the calling routine to recover fron such an eventu- > 

< ality, the reference to QMAT should be enbedded in a "try/ } 

{ recover" construct. > 
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function QCXQ< P , Q : QUATERNION ) : QUATERNION ; 

{ The value of this function is the quaternion product of the } 

< conjugate of P with Q; i.e., QCXQ(P,Q) = C o Q , where "o" > 

{ (circle) represents the quaternion multiplication operator > 
{ and C is the conjugate of P (the quaternion that results > 

{ from reversing the sign on all components of the vector part > 
{ of P). > 

function QXQ( P , Q : QUATERNION ) : QUATERNION i 

{ The value of this function is the quaternion product of P > 
{ with Q$ i.e., QXQ(P,Q) = P o Q, where "o" (circle) repre- > 
{ sents the quaternion multiplication operator. > 

function QXQC( P , Q : QUATERNION ) : QUATERNION ; 

{ The value of this function is the quaternion product of P > 

< with the conjugate of Q; i.e., QXQC(P,Q) = P o C, where “o' 1 > 

i (circle) represents the quaternion multiplication operator > 
{ and C is the conjugate of Q (the quaternion that results > 

■C from reversing the sign on all components of the vector part > 
f of Q). > 

function UNIQUAT( Q : QUATERNION ) : QUATERNION ; 

{ This routine normalizes the quaternion Q by computing the 
■C sum of the squares of all its components, and then dividing > 
{ each of them by the square root of that sum. The result is > 

{ returned to the calling routine as the value of UNIQUAT. 1 

< Normalization is required after each update of a (nominally) > 

{ unit quaternion (such as one being used to define the ori- > 
{ entation of a rigid body) when it is being integrated numer- > 
1 ically on a component-by-component basis (i.e., when the > 

< components are being integrated as if they were separate > 

{ scalar variables). > 
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function R0T( V : VECTOR ; Q : QUATERNION ) : VECTOR ; 

{ Given a vector V referenced to a Cartesian frame F, and a > 
{ unit quaternion Q defining the orientation of another frame > 
{ G with respect to F, this routine transforms V from F to G } 
t and returns the transformed vector to the calling routine > 
{ as the value of ROT. In terms of quaternion operations, } 

ROT( V,Q) ** C o V o Q, where "o“ (circle) represents the qua~ } 

< ternion multiplication operator, C represents the conjugate } 

t of Q, and V is treated as a quaternion whose scalar part is } 
{ zero. In terms of the equivalent matrix operations , > 

{ RQT(V,Q) ■ VXM( V, QMAT( Q ) ), which represents the actual > 

< method of computation used in this routine. } 

< If QFG is the name of the aforementioned quaternion in the > 

{ calling routine, and if VEC_F is the name of the vector } 

f when it is referenced to frame F, then the statement > 

< > 

< VEC_G R0T( VEC_F, QFG ) ; > 

< ) 

t yields the value of the vector when referenced to frame G. > 

{ When more than one vector is to be transformed, e.g. , } 

< > 

( P0S_G := R0T( POS_F, QFQ ) ; } 

< VEL_G := R0T( VEL_F , QFG ) ; } 

< > 

{ faster execution will be realized by the statement sequence > 

< } 

i MFG : = QMAT( QFG ) j > 

t P0S_G := VXM( P0S_F , MFG ) j > 

< VEL_G := VXM( VEL_F, MFG ) ? > 

< } 

{ which minimizes the overhead associated with forming the > 

< transf ormation matrix from the quaternion. } 
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function IR0T< V : VECTOR j Q : QUATERNION ) : VECTOR j 

{ IROT is the inverse of the ROT function. That is, given a > 

{ vector V referenced to a Cartesian frame G, and a unit } 

{ quaternion Q defining the orientation of G uith respect to > 

■C another frame F, this routine transforms V from G to F > 

{ and returns the transformed vector to the calling routine } 

{ as the value of IROT. In terms of quaternion operations, } 

{ IR0T<V,Q) * Q o V o C, where "o" (circle) represents the } 

f quaternion multiplication operator, C represents the conju- 1 

< gate of Q, and V is treated as a quaternion uhose scalar > 

f part is zero. In terms of the equivalent matrix operations, > 

{ IR0T<V,Q) ■ VXMT( V, QMAT( Q ) ), uhich represents the ac- } 

-C tual method of computation used in this routine. > 

< If QFG is the name of the aforementioned quaternion in the > 

{ calling routine, and if VEC_G is the name of the vector } 

{ uhen it is referenced to frame G, then the statement } 

< } 

< VEC_F := IROT( VEC_G, QFG > ; } 

< > 

{ yields the value of the vector uhen referenced to frame F. > 
i When more than one vector is to be transformed, e.g. , } 

< > 

i P0S_F := IROT( P0SJ3, QFQ ) 5 } 

{ VEL_F IROT( VEL_G, QFG ) 5 > 

< } 

{ faster execution uill be realized by the statement sequence } 

< y 

•C MFG : = QMAT( QFG ) ; } 

< PQS_F := VXMT ( POS_G, MFG ) j } 

f VEL_F := VXMT( VEL_G, MFG ) ; > 

< > 

f uhich minimizes the overhead associated uith forming the } 

{ transf ormat ion matrix from the quaternion. > 
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procedure DIAGONALIZE ( S : 5YMM3X3 ; 

TOLRATIO : longreal ; 

var D : DIAG3X3 5 

var M : MAT3X3 ) ; 

■C This procedure calls the DIAGONAL I ZE_SYMMATRIX procedure of > 
{ nodule UTILMATH, uhich uses the Jacobi nethod of iteration > 
-C to find an orthogonal natrix M that uill ( approxinately ) > 

{ transform an unknown diagonal matrix D into the symmetric > 
{ matrix S by use of the equation S = T * D * M, uhere is > 

{ the matrix multiplication operator and T is the transpose of > 
{ M. Iteration ceases when a value of M is found such that > 
{ every off-diagonal element of D’ = M * S * T (uhich is an } 

< approximation of D) , has an absolute value no greater the } 
{ product of the input parameter TOLRATIO uith the root-mean- > 
{ square magnitude of the diagonal elements of D. After the } 
{ convergence test is satisfied, the diagonal elements of the > 

< approximation D* are returned to the calling routine as the > 

{ components of the output variable D, along uith the final > 
f value of the transformation matrix M. > 

{ If NERTENS_B is a symmetric 3x3 matrix representing a rigid- > 
f body inertia tensor referenced to an arbitrary body-fixed > 
{ Cartesian frame B, then the tuo statements } 

< > 

{ DIAGONALIZE ( NERTENS_B, 1.0L-6, NERTENS_P , MPB ) ; > 

f PYRBP == QPYR( IMATQ( MPB ) ) j > 

< > 

i yield the principal moments of inertia (the three components > 
{ of the diagonal matrix NERTENS_P) to a numerical accuracy > 
{ of approximately one part in a million, plus the PCH/YAU/ROL } 
{ Euler angles (PYRBP) that define the orientation of the } 

f principal axes of inertia uith respect to the B system. MPB > 
f is a coordinate transf ormat ion matrix that can be used to } 

< transform vectors from reference system P ( uhose axes coin- > 

{ cide uith the principal axes of inertia) to system B. > 

f 1'f D’ has not converged to the specified tolerance after 150 > 
{ iterations, the values of M and D are NOT returned to the } 

< calling routine, and DI AGONALIZE_SYMMATRIX uill abort pro- > 

< gram execution uith an escapecode of 9902. The reference to } 

{ DIAGONALIZE should be embedded in a ’'try/recover“ construct } 
{ if it is desired to provide exception-handling code in the } 
{ calling routine to recover from such an eventuality. > 
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const 

HALF = 0.SL0 i 

function EULDEG< E : EULARR ) : EULARR ; 
var 

j : integer 5 

begin 

for j := 1 to 3 do EULDEGI j ] := ANGDEG( E£ j J ) 5 
end 1 

function EULRAD( E : EULARR ) : EULARR 5 
var 

j : integer ; 

begin 

for j := 1 to 3 do EULRADf j ] : = ANGRAD( E£ j 1 ) ? 
end 5 

function D0TP< V , U : VECTOR ) : longreal ; 
begin 

do tp := vm * um + vc z i * um + vt 3i * uc3i 5 

end ; 
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T begin externally invisible part of module > 
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function 


VMAG< V : VECTOR ) : longreal 5 


begin 


VMAG :=» sqrt< sqr( VM] ) + sqr( VI 2 J ) + sqr< Vf 31 ) ) 
end ; 


1 


function SXV< S : longreal 5 V : VECTOR ) : VECTOR 5 
var 

j : integer ; 

begin 

for j :=■ 1 to 3 do SXVtj] :=> S * V I j 1 5 
end ; 


function CRSP< V , W : VECTOR > : VECTOR j 


begin 
CR5P[ 1 ] 
CRSPC2] 
CRSPt 31 
end ; 



VIZ] * Ut 31 
VI 33 * um 

vtii * um 


ut 2 1 * vt 31 
wi 3i * vm 
um * vc z i 


¥5Efl7FA47 


1 


5- 1 3 



File ’Utilvenq. I ’ Page 14 
$ page $ 


Updated 0 23:11:19 Sat 27 Sep 198G 


•function VDIF( V , U : VECTOR ) : VECTOR 
var 


j : integer j 

begin 

for j := 1 to 3 do VDIFfj] := V[j] - 
end ; 


function VSUM( V , U : VECTOR ) : VECTOR 


var 


j : integer ; 


begin 

for j :* 1 to 3 do VSUMtj] := Vfj] + 
end ; 


WE j 1 i 


} 


UCjl 5 
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function VXDt V : VECTOR 5 D : DIAG3X3 ) : VECTOR 5 
var 

j : integer 5 

begin 

for j :* 1 to 3 do VXDtjl : = Vtj] * Dtj] } 
end ; 


function VXM< V : VECTOR 5 M : MAT3X3 ) : VECTOR } 
var 

i : integer 5 
j : integer ; 

W : VECTOR 5 

begin 

tJ := 2ERVEC 5 
for j :=> 1 to 3 do 

for i := 1 to 3 do 

Wtj] := Wtj] + Vti] * Mli.jl ; 

VXM := U 5 
end 5 


function VXMT( V : VECTOR ; M : MAT3X3 ) : VECTOR ; 
var 

i : integer 5 
j : integer 5 
W : VECTOR ,■ 

begin 

U := ZERVEC ; 
f or j : = 1 t o 3 do 

for i := 1 to 3 do 

Wtj] := Wtj] + VI i 3 * Mtj ,i] 5 
VXMT := U 5 
end ; 


¥07847704 


1 


5- 1 5 



File ’ Utilvemq. I ' Page 16 Updated @ 23:11:19 Sat 27 Sep 1986 

$ page $ 


function MDIF( L , M s MAT3X3 > : MAT3X3 5 
var 

i : integer ; 
j : integer ; 

N : MAT3X3 ; 

begin 

for i := 1 to 3 do 

for j :* 1 to 3 do 

Nfijl := Ui.j] - Mli.j] ; 
MDIF : * N 5 
end 5 


function MSUMC L , M s MAT3X3 ) : MAT3X3 5 
var 

i : integer ; 
j : integer ; 

N s MAT3X3 ; 


begin 

for i :® 1 to 3 do 

for j := 1 to 3 do 

NtiJ] Lti.j] + Mli.j] ; 
MSUM : = N ; 
end 5 
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function MXM< L , M : MAT3X3 ) : MAT3X3 ; 
var 

i : integer 5 
j : integer ; 
k : integer ; 

N : MAT3X3 ; 

begin 

N ZER3X3 5 
for i 1 to 3 do 

for j := I to 3 do 

for k 1 to 3 do 

NCiJ] NEiJ] + LE i ,k ] * MEkJ] ? 

MXM := N ; 
end 5 


function MXMT< L , M s MAT3X3 ) : MAT3X3 5 
var 

i : integer ; 
j : integer 5 
k : integer y 
N s MAT3X3 ; 

begin 

N := ZER3X3 ; 
for i :* 1 to 3 do 

for j 1 to 3 do 

for k := 1 to 3 do 

NEiJ] := Nlijl + Lli.kJ * MC j ,k ] ; 

MXMT :■ N 5 
end 5 

function MTXM( L , M : MAT3X3 ) : MRT3X3 i 
var 

i : integer ; 
j : integer 5 
k : integer 5 
N : MAT3X3 5 

begin 

N 2 * ZER3X3 i 
for i 1 to 3 do 

for j : = 1 to 3 do 

for k 1 to 3 do 

NEi,j3 :« NEiJ] + LCk.il * MCkJ] ; 

MTXM := N 5 
end 5 
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function MINV< M : MAT3X3 > s MAT3X3 ? 


var 


N : MAT3X3 ; 


begin 

INVERTJ1ATRIX ( M, 3, N ) ; 
MINV :® N 5 
end 5 


function IMATQt T : MAT3X3 > : QUATERNION ; 


var 

F : longreal 
i : integer 
j : integer 
R : longreal 
SAVE : longreal 
TEST : longreal 


begin { function IMATQ > 
for i :* 1 to 3 do 

for j := i to 3 do 
begin 

TEST D0TP( Tt i 3 , Tt j 3 ) ; 
if i = j then TEST := TEST - ONE ; 
if abs( TEST ) > UNITOL then 
escapet 9701 ) \ 

end ; 

TEST := ONE + TC 1,1 ] + Tt2,21 + TI3.31 ; 
if TEST >- ONE 


abort program execution > 


then 


begin { H comp > 

R sqrt ( TEST ) ; 

IMATQ. H HALF * R ; 

F := HALF / R ; 

IMATQ. I := ( Tt 2 , 3] - TC3.23 ) * F 

IMATQ. J ( Tt 3, 1 ] - Tt 1 ,33 ) * F 

IMATQ. K := ( Tt 1 ,23 - Tt2J] ) * F 

end t H comp > 


else 

begin { I test > 
SAVE TWO - TEST ; 
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TEST := SAVE + TWO * T[ 1 ,11 ; 
if TEST >= ONE 


then 

begin f I comp > 

R := sqrt( TEST ) ? 

IMATQ.I := HALF * R ; 

F := HALF / R ; 

IMATQ. J := < TCZ. 11 + TM ,Z1 > * F 

IMATQ.K := < TI3, 11 + Til ,3] > * F 

IMATQ. H := ( TI2.31 - Tf3,Z] ) * F 

end i I comp } 


el se 

begin < J test > 

TEST := SAVE + TWO * TIZ.Zl ; 
if TEST >= ONE 


then 


begin I i 

comp > 

R 

= sqrt( TEST ) ? 

IMATQ. J 

= HALF * R j 

F 

= HALF / R j 

IMATQ.K 

- ( Tt 3,21 + TI2.31 ) * F 

IMATQ. H 

- ( T[3,1] - TI J , 31 ) • F 

IMATQ.I 

= ( TI1.Z1 + TIZ.11 ) * F 

end { J comp > 

else 


begin <. K comp } 

TEST 

- SAVE + TWO * TI3.31 ; 

R 

= sqrt( TEST ) ; 

IMATQ.K 

= HALF * R ; 

F 

- HALF / R ; 

IMATQ. H 

= ( TC 1 ,21 - TIZ.11 ) * F 

IMATQ.I 

= ( Til, 31 + TI3.11 ) * F 

IMATQ. J 

= < TIZ.31 + JT3.Z1 ) * F 

end ; { K comp > 


I 

5 

3 


end ; < J test } 
end 5 f I test > 


end i { function IMATQ } 
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function 


PRYQ< PRY : EULPRY ) : QUATERNION ; 


var 


C : array [ 1..3 ] of longreal 

HAFANG : longreal ; 

m : integer ; 

S : array t 1 . . 3 ] of longreal 


begin 

for n 1 to 3 do 


begin 

HAFANG := HALF * PRYCnl ; 
CEnl cos( HAFANG ) ; 
St ml sin( HAFANG ) ? 
end ; 


PRYQ.H 

:= cm 

# 

Ct Z 1 

* 

Ct 33 

+ sm 

* 

sm 

# 

SC 33 ; 

PRYQ.I 

:= CM] 

# 

sm 

* 

Ct 33 

+ SM] 

* 

cm 

# 

St 3J 5 

PRYQ.J 

:= sm 

# 

cm 

* 

Ct 33 

- cm 

* 

SE 23 

* 

St 33 j 

PRYQ.K 
end 5 

:= cm 

* 

Ct Z I 

# 

St 33 

- sm 

* 

St 23 

# 

Ct 31 5 


function PYRQ( PYR : EULPYR ) : QUATERNION i 



C : array t I - • 3 1 of longreal 3 

HAFANG : longreal ; 

n : integer ; 

S : array t 1.-3 1 of longreal 3 

begin 

for n := I to 3 do 
begin 

HAFANG HALF * PYRtnJ ; 

Ctm] cos ( HAFANG ) ; 

St ml sin< HAFANG ) ; 

end 3 


PYRQ.H 

:=■ cm 

* 

Ct 2 3 

* 

Cl 33 

- sm 

* 

St 23 

# 

St 33 

PYRQ.I 

:*■ CM] 

* 

Ct 2 ] 

* 

St 3] 

+ St 13 

* 

SI 2 3 

# 

Ct 33 

PYRQ. J 

:= sm 

# 

Ct 2 3 

* 

Ct 33 

+ cm 

# 

SE 23 

# 

St 33 

PYRQ.K 
end ; 

:= cm 

* 

SE 2 3 

* 

Ct 33 

- sm 

* 

CI23 

* 

St 31 
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function RPRQ< RPR : EULRPR ) : QUATERNION ; 


var 


C 

HAFDIF 

HAFMID 

HAFSUM 

S 


begin 

HAFMID 

C 

S 

HAFDIF 
HAFSUM 
RPRQ.H 
RPRQ.I 
RPRQ. J 
RPRQ.K 
end ; 


longreal ; 
longreal 5 
longreal ; 
longreal ; 
longreal ; 


HALF 
cos( 
sin( 
HALF 
HALF 
C * 


* RPRt 2 ] 
HAFMID ) 
HAFMID ) 


* ( 
* < 
cos( 


C * sin( 
S * cos( 
S * sin< 


RPRI 1 ] 
RPRf 1 ] 
HAFSUM 
HAFSUM 
HAFDIF 
HAFDIF 


RPRt 31 
RPRt 31 

i 

? 


function YRYQt YRY : EULYRY ) : QUATERNION { 


var 


C 

HAFDIF 

HAFMID 

HAFSUM 

S 


begin 

HAFMID 

C 

S 

HAFDIF 
HAFSUM 
YRYQ.H 
YRYQ.I 
YRYQ. J 
YRYQ.K 
end ; 


longreal 

longreal 

longreal 

longreal 

longreal 


HALF * YRYtZ] 
cost HAFMID ) 
sin( HAFMID ) 
HALF * < YRYI1] 
HALF * ( YRYt 1 ] 


YRYt 33 
YRYt 33 


C * cost HAFSUM ) ; 
S * cost HAFDIF ) ; 
S * sint HAFDIF ) ; 
C * sint HAFSUM ) j 
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function QPRYC Q : QUATERNION ) : EULPRY ; 
var 

HAFDIF : longreal ; 

HAFSUM : longreal ; 

X : longreal ; 

Y : longreal ; 

Z : longreal ; 

begin 

HAFDIF ATAN2( Q.J - Q.K , Q.H + Q.I ) ; 

HAFSUM := ATAN2( Q.J + Q.K , Q.H -Q.I ) ; 

X 2* sqr( Q.H > - sqr( Q.I ) + sqr< Q.J ) 

Y := TWO * ( Q.I * Q.J + Q.H * Q.K > ? 

Z :« TWO * ( Q.H * Q.I - Q.J * Q.K ) ; 

QPRY m := ANGZ ( HAFSUM + HAFDIF ) ; 

QPRY [21 :* ATAN2( Z, sqrt( sqr( X ) + sqr( Y ) 
QPRY 133 AN62( HAFSUM - HAFDIF ) ; 

end 5 


function QPYR( Q : QUATERNION ) s EULPYR ; 
var 

HAFDIF : longreal ; 

HAFSUM : longreal ; 

X : longreal ; 

Y : longreal ; 

Z : longreal ; 

begin 

HAFDIF := ATAN2( Q.J - Q.I , Q.H - Q.K ) ; 

HAFSUM ATAN2( Q.J + Q.I , Q.H + Q.K ) ; 

X := sqr( Q.H ) - sqr< Q.I ) + sqr( Q.J) 

Y := TWO * ( Q.J * Q.K - Q.H * Q.I ) ; 

Z := TWO * ( Q.H * Q.K + Q.I * Q.J ) ; 

QPYR (13 ANG2( HAFSUM + HAFDIF ) ; 

QPYR E 23 := ATAN2( Z, sqrt< sqr< X ) + sqr< Y ) 
QPYR [33 := ANG2( HAFSUM - HAFDIF > ; 
end ; 


“ sqr( Q.K ) ; 
) ) ; 


sqr( Q.K ) ; 
) 5 
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function QRPR( Q : QUATERNION ) : EULRPR ; 
var 


HAFDIF : longreal ; 
HAFSUM : longreal j 
X : longreal ; 
Y : longreal ; 
Z : longreal ; 


begin 


HAFDIF 

= ATAN2( Q.K , 

HAFSUM 

= ATANZ< Q.I , 

X 

= sqr( Q.H ) + 

Y 

= sqr< Q.J ) + 

QRPR m 

= ANG2( HAFSUM 

QRPR I2J 

= TWO * ATAN2( 

QRPR 13] 

= ANG 2 ( HAFSUM 

end 1 



Q.J ) ; 

Q.H ) ; 
sqr( Q.I ) ; 
sqr( Q.K ) ; 

+ HAFDIF ) ; 

sqrt( Y ) , sqrt( X ) ) s 
- HAFDIF ) j 


function QYRY( Q 

: QUATERNION ) : EULYRY s 

var 


HAFDIF : 

longreal ; 

HAFSUM : 

longreal ; 

X : 

longreal ; 

Y : 

longreal ; 

Z 

longreal ; 


- ATAN2( Q.J , Q.I ) ; 

= ATAN2< Q.K , Q.H > ; 

= sqr( Q.H ) + sqr( Q.K ) ; 

= sqr( Q.I ) + sqr( Q.J ) 5 
= ANGZ( HAFSUM + HAFDIF ) ; 

= TWO * ATANZ( sqrt( Y ) , sqrt( X ) ) j 
« ANGZ( HAFSUM - HAFDIF ) ; 


begin 

HAFDIF 

HAFSUM 

X 

Y 

QYRY UJ 
QYRY £21 
QYRY 131 
end ; 
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function QMAT< Q : QUATERNION > : MAT3X3 ; 


var 


A 

B 

C 

G 

H 

I 

J 

K 

X 

Y 

Z 


longreal 
longreal 
longreal 
longreal 
longreal 
longreal 
longreal j 
longreal ; 
longreal ; 
longreal ; 
longreal ; 


begin 


A 

= 

sqr( Q 

.1 ) ! 

B 

= 

sqr( Q 

.J ) ; 

C 


sqr( Q 

.K ) ! 

G 


sqr( Q 

.H ) 5 

if 

abs< G + 

A + B + C 



escape 

( 9702 ) ; 

H 

35 

G - A ■ 

- B - C ; 

I 

= 

TWO * Q.H * Q.I 

J 

=3 

TWO * Q.H * Q.J 

K 

S 

TWO * Q.H # Q.K 

X 

- 

TWO * Q.J * Q.K 

Y 

3 = 

TWO * Q.K * Q.I 

Z 

= 

TWO * Q.I * Q.J 

QMAT 

11,11 

= H + A + 

QMAT 

I 1 ,ZI 

= Z - K j 

QMAT 

M ,31 

= Y + J ; 

QMAT 

12,11 

= Z + K i 

QMAT 

12,21 

= H + B + 

QMAT 

12,31 

= X - I j 

QMAT 

[3,11 

« Y - J s 

QMAT 

13,21 

* X + I 5 

QMAT 

13,31 

= H + C + 

end ; 




- ONE ) > UNITOL then 


{ abort program execution > 


B 
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function QCXQ< P , Q : QUATERNION 

begin 
with P do 
begin 

QCXQ.H := H * Q.H + I * Q 
QCXQ.I :« H * Q.I - I * Q 
QCXQ.J :=H*Q.J-J*Q 
QCXQ.K := H * Q.K - K * Q 
end ; 

end ; 


function QXQ< P , Q : QUATERNION > 

begin 
with P do 


begin 

QXQ.H 

:= H 

* 

Q.H 


I 

* 

Q. 

QXQ.I 

:= H 

* 

Q.I 

+ 

I 

* 

Q. 

QXQ.J 

:» H 

* 

Q.J 

+ 

J 

* 

Q. 

QXQ.K 
end ; 

:= H 

* 

Q.K 

+ 

K 

* 

Q. 


end ; 


function QXQC< P , Q : QUATERNION ! 

begin 
with P do 
begin 

QXQC.H :=H*Q.H+I*Q. 
QXQC.I := I * Q.H - H * Q. 
QXQC.J := J * Q.H - H * Q. 
QXQC.K :-=K*Q.H-H*Q. 
end ; 

end ; 


function UNIQUAT( Q : QUATERNION ) 
var 


F : longreal ; 


begin 

F :*= ONE / sqrt( sqr( Q.S ) 
UNIQUAT. S := F * Q.S j 
UNIQUAT. V := SXV< F, Q.V ) ? 
end ; 


> : QUATERNION 5 


.1 + J * Q.J + K * Q.K 
.H - J * Q.K + K * Q.J 
.H - K * Q.I + I * Q.K 
.H - I * Q.J + J * Q.I 


: QUATERNION ; 


- J * Q.J - K * Q.K 5 
+ J * Q.K - K * Q.J s 
+ K * Q.I - I * Q.K 5 
+I*Q.J-J*Q.I ; 


: QUATERNION ; 


I + J * Q.J + K * Q.K 
I - J * Q.K + K * Q.J 
J - K * Q.I + I * Q.K 
K - I * Q.J + J * Q.I 


: QUATERNION ; 


D0TP( Q.V, Q.V ) ) j 
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function R0T< V : VECTOR 5 Q : QUATERNION > 
begin 

ROT :« VXM( V, QMAT< Q > ) ; 
end ; 


function IR0T< V : VECTOR; Q : QUATERNION ) 
begin 

IROT := VXMT( V, QMAT( Q > ) ; 
end ; 


procedure DIAGONALIZE ( 

var 

var 


s 

SYMM3X3 

5 

TOLRATIO 

longreal 

5 

D 

DIAG3X3 

i 

M 

MAT3X3 

) 


begin 

OIAGONALIZE_SYMMATRIX ( S, 3, TOLRATIO, 
end ; 

end ; < nodule UTILVEMQ & File ’Utilvenq.I’ 


: VECTOR ; 
: VECTOR ; 


D, M ) ; 
} 
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File ’ Ut ilstat . I ’ Page 1 
$ page $ { begin File ’Utilstat.I’ > 

< Utility Software Unit for HP-9000 Series 
nodule UTILSTAT ; f Subject : Statistics 

< NASA/ JSC/MPAD/TRW 

< Updated 17:58:10 Fri 


Updated & 17:58:30 Fri 

Z00/300/500 Computers > 

> 

Sam Uilson > 

12 Sep 1986 > 


12 Sep 1986 


import 

UTILMATH , 

UTILSPIF j 

export { begin externally visible declarations > 

type 

SIXVEC = fa six-vector (row matrix). > 

array II.. 61 of longreal 5 { Index ■ matrix column number. } 


SIXPOPDEF *> f an array defining a population } 

array If. .211 of longreal i ( of six-vectors whose components > 

f are zero-mean random numbers > 

{ having correlated Gaussian > 

{ (normal) distributions. The elements of the array, in > 

{ the order of storage, are: > 

< } 

{ Sill, } 

< ci2.il, sm, > 

< CI3.11 , CI3.21 , SI 31, > 

t CI4.11 , CI4.21 , CI4.31. SI41 , > 

< CI5.11, CI5.21, CI5.31, CCS.41, SIS1, > 

< CI 6 . 11 . CI6.21. CI6.31, CI6.41, CI6.S1, SI61. > 

< > 

{ where Sljl is the standard deviation of the jth compo- } 


< nent and Cli.jl = CIj.il is the coefficient of correla- > 

< tion between components i and j. The magnitudes of the > 
{ Cli.jl must be less than ONE (unity), and the Sljl must } 
{ be positive. This array is related to the population > 


{ covariance matrix COVAR through the equation } 

< > 

{ COVARIi.jl - SI il * Sljl * Cii.jJ , > 

< > 

< where Clj.jl = ONE by definition. The 6 x 6 correlation } 

< matrix composed of the Cli.jl (including the ONE values > 

{ on the main diagonal) must be positive definite. > 

TRIANG 6 X 6 = f an array containing the nonzero > 

array I 1 ..Z 1 J of longreal ; { elements of a 6 x 6 triangular > 

{ matrix (see TRIANGMAT type dec- 1 
( laration in module UTILMATH). > 
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$ page $ 
var 

RUNNUM : integer 5 < Identification number for a simulation run > 

{ in a Monte Carlo series. If RUNNUM >0, } 

< the assumed purpose of the run is to analyze } 

< the effects of random dispersions and errors and/or to gen- > 

{ erate Monte Carlo statistics, and all the pseudorandom num- } 

< ber functions defined in this module ( UNIFORM_RANDOM_SCALAR, } 
{ GAUSSI AN_RANDOM_SC AL AR , GAUSSIAN_RANDOM_SIXVECTOR) will have > 

< nonzero values. If RUNNUM <= 0, the assumed purpose is to } 

< analyze or to familiarize the simulator pilot with the nomi- } 

< nal situation, and the pseudorandom functions uill have zero > 

{ values. } 

function UNIFORM_RANDOM_SCALAR( UNCERTAINTY : longreal ) : longreal j 

< If RUNNUM > 0, the value of this function is a pseudorandom > 

< number from a population uhich is uniformly distributed > 

<■ over the interval between -UNCERTAINTY and +UNCERTAINTY. > 

{ If RUNNUM <=0, the value of this function is ZERO. > 

function GAUSSI AN_RANDOM_SCALAR( SIGMA : longreal ) : longreal ; 

< If RUNNUM > 0, the value of this function is a pseudorandom } 
{ number from a Gaussian (i.e., normally distributed) popula- > 

< tion having a mean of zero and a standard deviation (square > 

{ root of variance) equal to SIGMA. If RUNNUM <= 0, the > 

{ value of this function is ZERO. } 
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function SIXTUC_MATRIX( SIXPOP : SIXPOPDEF ) : TRIANG 6 X 6 ? 

i The value of this function is an upper triangular 6 x 6 matrix > 
f that can be used to transform a six-vector of uncorrelated } 
{ zero-mean unit- variance Gaussian psedorandom numbers (U) } 

{ into a pseudorandom six-vector of correlated components (V) > 

< from the population defined by SIXPOP. The transformation > 

-C is defined by the equation } 

< } 

i V - U * SIXTUC_MATRIX< SIXPOP ) , } 

< > 

{ where represents the matrix multiplication operator and } 

< the components of U are GAUSSIAN_RflNDOM_SCALflR function > 

{ values, viz: > 

< > 

< Ulj] - GflUSSIflN_RGNDOM_SCRLflR( ONE ) } 

< y 

{ for j * 1 , 2 ,. ... 6 . > 

f If any one of three possible error conditions are found to } 

< exist in SIXPOP, the value of SIXTUC_MATRIX is undefined, > 

{ and program execution will be aborted. The escapecode is > 
•£ set equal to 9601 if one of the standard deviations (StjJ) > 
{ is found to be zero or negative. The escapecode is set to 1 
{ 960Z if an off-diagonal coefficient of correlation (Cli.jl) > 
{ is found to be greater than or equal to ONE. If the corre- > 
■£ lation matrix is found to be other than positive definite, } 
•{ the escapecode is set equal to 9603. The reference to } 

{ SIXTUC_MATRIX should be embedded in a "try/recover" con- > 

{ struct if it is desired to provide exception-handling code > 
{ to recover from such eventualities. > 

function GAUS5IAN_RAND0M_SIXVECT0R( SIXTUC : TRIGNG 6 X 6 ) : SIXVEC 5 

{ Given SIXTUC = SIXTUC_MATRIX< SIXPOP ), this routine will > 

< compute a pseudorandom Gaussian six-vector from the popula- } 

< tion defined by SIXPOP, and return it to the calling routine > 

< as the value of GAUSSIftN_RANDOM_SIXVECTOR. If RUNNUM <= 0 , } 

{ every component of GAUSSIAN_RflNDOM_SIXVECTQR will have a } 

< value of ZERO. } 


¥Z1BDCG1D 


1 _ G- 3 



File 1 lit i lstat . 1 9 Page 4 
$ page $ 


Updated © 17:58:30 Fri 1Z Sep 1986 


implement { begin externally invisible part of module > 

function UNI F ORM_RANDOM_SC AL AR( UNCERTAINTY : longreal ) : longreal 5 
var 


R : longreal 5 
X : longreal ; 


begin 

R : = maxint ; 

X := RANDOMS NTEGER / R ; 
if RUNNUM > 0 

then UNI FORMER A ND0M_SC ALAR := ( TWO * X - ONE ) * UNCERTAINTY 
else UNI FORM_RANDOM_SC ALAR : - ( TWO * X - ONE ) * ZERO ; 

end ; 


function GAUSSIAN_RANDOM_SCALAR( SIGMA : longreal ) : longreal ; 
var 


G : longreal ; 
n : integer ; 
X : longreal ; 


begin 

X := ZERO s 

for n :* 1 to 12 do 

X := X + RANDOMS NTEGER ; 

G X / maxint - SIX ; 
if RUNNUM > 0 

then GAUSSIAN_RANDQM_SCALAR := G * SIGMA 
else GAUSSI AN_RANDOM_SCALAR := G * ZERO ; 

end ; 
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function SIXTUC_MATRIX( SIXPOP : SIXPOPDEF ) : TRIANGGXG ? 

< Ref: Subroutine SAMPLE in Program OMDAP, coded by Elric McHenry } 

< (modified by D. M. Braley), NASA/JSC/MPAD, ante April 1976 > 


const 


SIZE = 6 } { number of vector components } 


var 


begin 
for i 


i 


integer 

i 

ii 


integer 

? 

ij 


integer 

? 

j 


integer 

5 

j j 


integer 

I 

k 


integer 

S 

M 


TRIANG6X6 

5 

X 


longreal 

» 

i 

i 

to SIZE 

do 


{ illegal standard deviation > 


begin 

ii :» TRIANG_I NDEX( i, i ) ; 
if SIXPOPlii] <= ZERO then 
escape ( 9601 ) ; 

X := ONE ; 
if i > 1 then 

for k := 1 to i -1 do 

X := X - sqr( MI TRI ANG_I NDEX( k , i ) 1 ) j 
if X > ZERO 

then MI ii] := sqrt( X > 

else escape ( 9B03 ) ; { correlation matrx is not pos definite > 
if i < SIZE then 

for j := i +1 to SIZE do 
begin 

ij := TRIANG_INDEX( i, j ) ; 
if abs( SIXPOPlij] ) < ONE 
then X := SIXPOPlij] 

else escape ( 9G02 ) ; { illegal correlation coeff > 

if i > 1 then 

for k := 1 to i -1 do 

X := X - MI TRIANG_INDEX( k , i )] * 

MI TRIANG_INDEX( k , j )] j 
Mlij] : = X / MI ii ] ; 
end 5 

for j := i to SIZE do 
begin 

ij := TRIANG_INDEX< i, j ) ; 
jj := TRIANG_INDEX< j, j ) ; 

SIXTUC_MATRIXI i j ] := Mlij] * SIXPOPljj] ; 
end j 

end ; 


end ; 
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function GAUSSIAN J*AND0f1_SIXVECT0R< SIXTUC s TRIANG 6 X 6 ) : SIXVEC 3 
var 

i : integer ; 

ij : integer ; 

j : integer 5 

k : integer ; 

U : SIXVEC 5 

V : SIXVEC 5 

begin 

for j := 1 to G do 

Utj] :*= GAU5SIAN__RAND0M_SCALAR( ONE ) ; 
for j : = 1 to G do 
begin 

VCj] := ZERO ; 
for i :« 1 to j do 

VC j 3 VC j 3 + Util # SIXTUCC TRI ANG_INDEX< i , j > ] ; 

end 3 

GAUSSI AN_RANDGM_SIXVECTOR V ; 
end ; 


end ; < nodule UTILSTAT & File ’Utilstat.I* > 
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/* Utility Software Unit for HP-9000 Series 500 with HP-UX 5.0 Op Sys */ 
void main< ) i } /* Subject : Systen/C Interface */ 

/* NASA/JSC/MPAD/TRU : San lUlson */ 


/* This conpilation unit contains the C functions */ 
/* required to interface the PASCAL code with the */ 
/* appropriate HP-UX utility routines. */ 


# include <curses.h> 

/* */ 

void clearline() 

int row ; 
int col 5 

getyx( stdscr, row, col ) i 
nove( row, 0 ) ; 
clrtoeoK ) ; 
refresh( ) ; 

> 


/* */ 

void clearscreen( ) 

< 

clear< ) ; 
refresh< > ? 

} 

/* */ 

void fetchpac( s ) char *s ; 
f 

getstrt s ) ; 

} 


/* #/ 

void ioinitial ize( ) 

initscr( ) ; 
scrollok( stdscr, 1 ) 5 
refresh( > ; 

} 


/* »/ 

void iouninitial ize () 

{ 

enduin( ) ; 
exit( 0 ) ; 

> 


/* 


*/ 
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void moveuplrouK ) 
f 

int row i 
int col ; 

getyx< stdscr, rou, col ) ; 
move( row- 1 , col ) ; 
refresh* ) 5 
> 

/* */ 

void restorecursor* ) / * uses terminfo(G) "bold" string entry, which */ 

< /* must be defined in such a fashion that */ 

attrset* A_B0LD ) ; /* when transmitted to terminal it will */ 

> /* make the cursor become visible */ 

/* */ 

void setbr ightbl ink i( ) /* uses terminfo(G) “blink" string entry, which */ 

< /* must be defined in such a fashion as to set */ 

attrset( A.J3LINK ) ; /* the terminal in the blinking inverse video */ 

> /* display mode */ 

/* */ 

% 

void setcbreak( ) 

cbreak( ) ; 

> 

/* */ 

void setcecho( ) 

{ 

echo( ) ; 

> 

/* */ 

void setcwait( ) 

nodelay* stdscr, FALSE ) ; 

> 

/* #/ 

void sethalfbright i( ) /* uses terminfo(G) "din" string entry, which */ 

{ /* must be defined in such a fashion as to set */ 

attrset( A_DIM ) 5 /* the terminal in the halfbright inverse #/ 

> /* video display mode */ 

/* #/ 

void setnocbreak ( ) 
i 

nocbreak* ) ; 

} 

/* #/ 
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void setnocecho( ) 

< 

noecho( ) j 
} 

#/ 

void setnocwai'K ) 

nodelay( stdscr, TRUE ) 5 
} 

#/ 

void setnormal video( ) 
f 

attrset( A_NQRMflL ) ? 

> 

/* #/ 

void shoupac( s ) char *s j 

< 

addstr( s ) ; 
refresh( ) ; 

> 

/*___ »/ 

void soundalert( ) 

{ 

beep( ) j 

> 

#/ 

void suppresscursor( ) /* uses terminfo<5) "prot" string entry, which */ 

{ /* must be defined in such a fashion that */ 

attrset< fl_PROTECT ) ; /■* when transmitted to the terminal it */ 

1 /* will make the cursor become invisible */ 

/* */ 

int kbdcharcode( ) 
f 

return getch( ) ; 

> 

/* #/ 

/* end File ’utilscif.c’ */ 
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File ’ UTILTEST. TEXT’ Page 1 
< begin File ’ UTILTEST. TEXT’ > 

{ Utility Software Unit for HP-9000 Model Z16 with Pascal 3.0 Op Sys > 

$ Sysprog On $ 

$ search ’UTILUNIT’ $ 

$ Ref 60 $ 

program TEST_UTILITY_SQFTWARE_UNIT ( input, output ) ; 

< NASA/ JSC/MPAD/ TRW : Sam Wilson > 

import 

UTILMATH , 

UTILSPIF , 

UTILVEMQ , 

UTILSTAT ; 


const 


D 

= 

DIAG3X3 [ 

30.0L0, 

10.0L0, 

40.0L0 

I 

K 

= 

MAT3X3 t 







VECTOR [ 

Z5.0L0, 

0.0L0, 

0.0L0 

1 



VECTOR [ 

0.0L0, 

40.0L0, 

0.0L0 

I 



VECTOR [ 

0.0L0, 

0.0L0, 

55.0L0 

I 

L 

= 

MAT3X3 [ 







VECTOR f 

ONE, 

TWO, 

-THREE 

I 



VECTOR f 

-TWO, 

FIVE, 

SIX 

I 



VECTOR [ 

FOUR, 

THREE , 

-FOUR 

1 

M 

s = 

MAT3X3 [ 







VECTOR [ 

ONE, 

THREE , 

NINE 

I 



VECTOR [ 

FOUR, 

FIVE, 

SIX 

] 



VECTOR [ 

SEVEN, 

EIGHT, 

TWO 

1 

PRY 

a? 

EULPRY [ 

-145. 0L0, 

65.0L0, 

- 170.0L0 

I 

PYR 

= 

EULPYR [ 

80.0L0, 

-35.0L0, 

1Z0.0L0 

1 

RPR 

» 

EULRPR [ 

10.0L0, 

-15.0L0, 

Z0.0L0 

I 

YRY 

— 

EULYRY [ 

-5.0L0, 

80.0L0, 

-55.0L0 

I 

V 

s 

VECTOR [ 

TWO, 

-SIX, 

THREE 

1 

W 

c= 

VECTOR [ 

FOUR, 

FIVE, 

-ONE 

] 


type 


CLASSREC = 
record 

VUB : longreal ? 
CDF : longreal 5 
end ; { record } 


t record of data pertaining to one class of } 
{ values for a continuous random variable > 
value of the upper bound for this class > 

cumulative distribution function for this class > 


CLASSARR - 

array [ 0..10 ] of CLASSREC ; 


{ description of the distribution > 
f of a continuous random variable > 


DESCRIPSTR = string I ZZ I 5 I descriptive text for an output quantity > 


¥ZZ7Z4C3Z 
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File ’ UTILTEST. TEXT’ Page 2 
$ page $ 


Updated @ 08:05:08 Mon 29 Sep 1986 


const 


NULLDESCRIP 

TENSPACES 


< 1 2345678901 2 345G78901 2 > 

» * . 


var 


CLOCKSAVE 

CPUSAVE 

E 

H 

N 

OUTLINE 

P 

0 

R 

S 

TIME 

X 


integer ; 
integer ; 
DIAG3X3 ; 
integer ; 
MAT3X3 ; 
LINESTR j 
QUATERNION ; 
QUATERNION ; 
QUATERNION ; 
SYMM3X3 ; 
longreal ; 
VECTOR ; 


procedure PRINT_FIXEO_SCALAR ( DESCRIP : 
procedure PRINT_FIXED_DIAG3X3( DESCRIP : 
procedure PRI NT_F I XED_EUL ARR ( DESCRIP : 
procedure PRINT_FIXED_VECTOR ( DESCRIP : 
procedure PRINT_FIXE0_MAT3X3 ( DESCRIP : 
procedure PRINT_FIXED_SIXVEC < DESCRIP : 
procedure PRINT_FIXED_SIXPOP ( DESCRIP : 

procedure PRINT_FLOAT_SCALAR ( DESCRIP : 
procedure PRI NT_FLQAT_EUL ARR ( DESCRIP : 
procedure PRINT_FLOAT_VECTOR ( DESCRIP : 
procedure PRI NT_FL0AT_MAT3X3 ( DESCRIP : 
procedure PRINT_F10AT_SIXP0P ( DESCRIP : 


DESCRIPSTR 

i 

s 

longreal 

) 

5 forward; 

DESCRIPSTR 

$ 

D 

DIAG3X3 

) 

; f orward; 

DESCRIPSTR 

1 

E 

EULARR 

) 

; f orward; 

DESCRIPSTR 

? 

V 

VECTOR 

) 

; f orward; 

DESCRIPSTR 

5 

M 

MAT3X3 

> 

i f orward; 

DESCRIPSTR 

i 

V 

SIXVEC 

) 

; forward; 

DESCRIPSTR 

5 

s 

SIXPOPDEF > 

5 f orward; 

DESCRIPSTR 

» 

S 

longreal 

) 

; forward; 

DESCRIPSTR 

? 

E 

EULARR 

) 

; f orward; 

DESCRIPSTR 

5 

V 

VECTOR 

) 

; forward; 

DESCRIPSTR 

9 

M 

MAT3X3 

) 

; forward; 

DESCRIPSTR 

5 

s 

SIXPOPDEF) 

; f orward; 


procedure TEST_UTILVEMQ_VECTOR_FUNCTIONS 

procedure TEST_UTI LVEMQ_MATRI X_FUNCTI ONS 

procedure TEST_UTILVEMQ_IMATQ_FUNCTION 

procedure TEST_UTILVEMQ_EULER_QUAT_FUNCTIONS 

procedure TESTJJTI LVEMQ_QUAT_ROT_FUNCTI ONS 

procedure TEST_UTILVEMQ_UNIQUAT_FUNCTION 

procedure TESTJJTILVEMQ_MATRIX_DI AGONALIZATION 

procedure TEST_UTILSTAT_UNIFORM_RANDOM_SCALAR_FUNCTION 

procedure TESTJJTI LSTATJ3AU5SIAN_RANDGM_SCALAR_FUNCTION 

procedure TEST_UTILSTAT_SIXTUC_MATRIX_FUNCTION 

procedure TEST_UTILSTAT_GAUSSI AN_RANDOM_SIXVECTOR_FUNCTION 


5 forward} 
} forward; 
; forward; 
; f orward; 
; f orward; 
; forward; 
; forward; 
; forward; 
; forward; 
; f orward; 
; forward; 


$ include 
$ include 
$ include 
$ include 
$ include 


’Prtprocs. I . ’ $ 
’ Testmath. I . * $ 
' Testspif . I . * $ 
’ Testvemq. I . ' $ 
’ Teststat . I . * $ 
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File ' UTILTEST. TEXT’ Page 3 
$ page $ 


Updated @ 08:05:08 Mon 29 Sep 1986 


begin { program TEST_.UTILITY_SOFTUARE_UNIT > 

INITim.IZE_IO j 

CLOCKSAVE := CLOCKTICK 5 

CPUSAVE := CPUTICK 5 

reurite ( LP, ’UTILTEST. R’ ) ; 


if USER_DECIDES_TO( ’Teat UTILMATH nodule’ 
if USER_DECIDES_TO( ’Test UTILSPIF nodule’ 
if USE R_DE C I DE S_T 0 ( ’Test UTILVEMQ nodule’ 
if USER_DECIDES_TO( ’Test UTILSTAT nodule’ 


) then TESTJJTI LMATH_MODULE ; 
) then TEST_UTILSPIF_MODULE ; 
) then TEST_UTI LVEMQ_MODULE s 
) then TEST_UTIL5TAT_M0DULE j 


for H := 1 to 5 do uriteln ( LP ) ; 

OUTLINE := ’Tests completed @ ’ + DATESTRING ; 

SHOWLN ( OUTLINE ) 5 

SHOWLN ( ” ) ; 

uriteln ( LP , OUTLINE ) ; 

uriteln ( LP ) ; 


TIME := ( CPUTICK - CPUSAVE > / TICKSPERSEC 5 
OUTLINE := ” ; 

strurite ( OUTLINE, 1 ,H, 'CPU time =» ’,TIME:5:Z,’ seconds’ ) } 
SHOULN ( OUTLINE ) ? 

SHOULN ( ” ) ; 
uriteln ( LP, OUTLINE ) ; 
uriteln < LP ) ? 


TIME := ( CLOCKTICK - CLOCKSAVE ) / TICKSPERSEC 5 
OUTLINE := ” ; 

strurite ( OUTLINE, 1 ,H, ’Elapsed time = ’,TIME:5:Z,’ seconds' ) 5 
SHOULN ( OUTLINE ) ; 

SHOULN ( ” ) 5 
uriteln ( LP, OUTLINE ) 5 
uriteln ( LP ) 5 


close ( LP, ’SAVE’ ) 5 

SHOULN ( ’Test results have been saved in text file ’ ’UTILTEST. R* ’ ’ ) ; 
LOITER < 500 ) i 
CLEAN_UP_IO t 

end . { program TEST_UTILITY_SOFTUARE_UNIT & File ’ UTILTEST. TEXT’ > 
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File ’utiltest.p’ Page 1 

< begin File ’utiltest.p’ } 

< Utility Softuare Unit for HP-9000 Series 500 with HP-UX 5.0 Op Sys > 

$ standard_level ’ hp_modcal ’ $ 

$ search ’utilunit.o’ $ 

program TEST_UTILITY,_SQFTUARE_UNIT ( input, output ) ; 

{ NASA/ JSC/MPAD/TRU : Sam Wilson > 

import 

UTILMATH , 

UTILSPIF , 

UTILVEMQ , 

UTILSTAT 5 

const 


D 

- 

DIAG3X3 [ 

30.0L0, 

10.0L0, 

40.0L0 

1 

K 

8 

MAT3X3 1 







VECTOR [ 

25.0L0, 

0.0L0, 

0.0L0 

1 



VECTOR t 

0.0L0, 

40.0L0, 

0.0L0 

1 



VECTOR I 

0.0L0, 

0.0L0, 

55.0L0 

1 

L 

SS 

MAT3X3 1 







VECTOR [ 

ONE, 

TUO, 

-THREE 

1 



VECTOR I 

-TUO, 

FIVE, 

SIX 

1 



VECTOR [ 

FOUR, 

THREE , 

-FOUR 

] 

M 

as 

MAT3X3 1 







VECTOR 1 

ONE, 

THREE , 

NINE 

1 



VECTOR [ 

FOUR, 

FIVE, 

SIX 

1 



VECTOR I 

SEVEN, 

EIGHT, 

TUO 

1 

PRY 

as 

EULPRY [ 

-145. 0L0, 

65.0L0, 

- 170.0L0 

1 

PYR 

* 

EULPYR [ 

80.0L0, 

-35.0L0, 

120.0L0 

] 

RPR 

= 

EULRPR 1 

10.0L0, 

-15.0L0, 

20.0L0 

] 

YRY 

■ 

EULYRY 1 

-5.0L0, 

80.0L0, 

-55.0L0 

1 

V 

= 

VECTOR 1 

TUO, 

-SIX, 

THREE 

] 

U 

« 

VECTOR t 

FOUR, 

FIVE, 

-ONE 

1 


type 


CLASSREC - 
record 

VUB : longreal t 
CDF : longreal ; 
end ; { record > 


{ record of data pertaining to one class of > 
{ values for a continuous random variable } 
{ value of the upper bound for this class > 

< cumulative distribution function for this class } 


CLASSARR = 

array I 0. .10 ] of CLASSREC 


{ description of the distribution } 
( of a continuous random variable } 


DESCRIPSTR = string [ 22 1 


{ descriptive text for an output quantity > 
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Updated @ 08:06:06 Mon Z9 Sep 1986 


const 


NULLDESCRIP 

TENSPACES 


var 


{ 1 Z 345678901 Z 34567890 1 Z > 

• * . 


CLOCK SAVE 

CPUSAVE 

E 

H 

N 

OUTLINE 

P 

Q 

R 

S 

TIME 

X 


integer 

integer 

DIAG3X3 

integer 

MAT3X3 

LINESTR 

QUATERNION 

QUATERNION 

QUATERNION 

SYMM3X3 

longreal 

VECTOR 


procedure PRINT_FIXED_SCALAR ( DESCRIP 
procedure PRINT„FIXE0_DIAG3X3< OESCRIP 
procedure PRINT_FIX£D_EULARR < DESCRIP 
procedure PRINT_FIXEO_VECTOR < DESCRIP 
procedure PRINT_FIXED_MAT3X3 ( DESCRIP 
procedure PRINT_FIXED_5IXVEC ( DESCRIP 
procedure PRINT_FIXED_SIXPOP ( DESCRIP 

procedure PRI NT_FLOAT_SCALAR ( OESCRIP 
procedure PRINT_FLOAT_EULARR ( DESCRIP 
procedure PRI NT_FL0AT_ VECTOR < DESCRIP 
procedure PRINT_FL0AT_MAT3X3 ( DESCRIP 
procedure PRINT_FLOAT_SIXPOP ( DESCRIP 


DESCRIPSTR 

5 

s 

longreal 

) 

; forward; 

DESCRIPSTR 

5 

D 

DIAG3X3 

) 

; forward; 

DESCRIPSTR 

? 

E 

EULARR 

) 

; forward; 

DESCRIPSTR 

5 

V 

VECTOR 

) 

; forward? 

DESCRIPSTR 

; 

M 

MAT3X3 

> 

; forward; 

DESCRIPSTR 

« 

V 

SIXVEC 

) 

; forward; 

DESCRIPSTR 

5 

S 

: SIXPOPDEF ) 

; forward; 

DESCRIPSTR 

5 

S 

longreal 

) 

; f orward; 

DESCRIPSTR 

5 

E 

EULARR 

) 

; f orward; 

DESCRIPSTR 

5 

V 

VECTOR 

) 

5 forward; 

DESCRIPSTR 

» 

M 

MAT3X3 

) 

; forward; 

DESCRIPSTR 

5 

S 

: SIXPOPDEF) 

; f orward? 


procedure TEST_UTILVEMQ_VECTOR_FUNCTIONS 

procedure TEST.UTI L VEMQ_MATRI X_FUNCTI ONS 

procedure TEST_UTI L VEMQ_I MATQ_.FUNCTI ON 

procedure TEST_UTI LVEMQ_EULER_QUAT_FUNCTI ONS 

procedure TEST_UTI L VEMQ_QUAT_ROT_FUNCTI ONS 

procedure TEST_UTILVEMQ_UNIQUAT_FUNCTION 

procedure TEST_UTI L VEMQ_MATRI X_DI AGONALI Z ATI ON 

procedure TEST_UTILSTAT_UNIFORM_RANDOM_SCALAR_FUNCTION 

procedure TEST_UTILSTAT_GAUSSIAN_RANDOM_SCALAR_FUNCTION 

procedure TEST_UTILSTAT_SIXTUC_MATRIX_FUNCTION 

procedure TEST_UTILSTAT_GAUSSIAN_RANDOM_SIXVECTOR_FUNCTION 


; f orward; 
5 forward? 
; forward; 
; f orward; 
; f orward; 
; forward; 
; forward; 
; forward; 
; f orward; 
; forward; 
; f orward; 


$ include 
$ include 
$ include 
$ include 
$ include 


’Prtprocs.I" $ 
’ Testnath. I ’ $ 
' Testspif . I ’ $ 
’ Testvenq. I ’ $ 
’ Teststat . I ’ $ 


¥08588358 


Z . 1 . z-z 



File ’ ut il test . p’ Page 3 

$ page $ 


Updated @ 08:06:06 Mon 29 Sep 198G 


begin { program TEST_UTILITY_SOFTWARE_UNIT > 
INITIALIZE_IQ } 

CLOCKSAVE := CLOCKTICK 5 
CPU5AVE := CPUTICK ; 
rewrite ( LP, ’utiltest.R’ ) } 


if USER_DECIDES_TO( ’Test 
if USER_DECIOES_TO( ’Test 
if USE R_DE C I DE S_T0 ( ’Test 
if USER_DEC I DE 5 _T0( ’Test 


UTILMATH nodule’ ) then 
UTILSPIF nodule’ ) then 
UTILVEMQ nodule’ ) then 
UTILSTAT nodule’ ) then 


TEST_UTILMATH_MODULE ; 
TEST_UTI LSPI F_MOOULE ; 
TEST_UTILVEMQ_MODULE j 
TEST_UTILSTAT MODULE 5 


for H := 1 to 5 do uriteln ( LP ) ; 

OUTLINE :» ’Tests completed @ ’ + DflTESTRING ; 

SHOWLN ( OUTLINE ) i 

SHOWLN ( ” ) 5 

uriteln ( LP, OUTLINE ) ; 

uriteln ( LP ) 5 


TIME := ( CPUTICK - CPUSAVE ) / TICKSPERSEC 5 
OUTLINE :=■ ” ; 

strurite ( OUTLINE , 1 ,H, 'CPU time = ’,TIME:5:Z,’ seconds’ ) } 
SHOWLN ( OUTLINE ) ; 

SHOWLN ( ” ) 5 
uriteln < LP, OUTLINE ) s 
uriteln < LP > 1 


TIME := < CLOCKTICK - CLOCKSAVE ) / TICKSPERSEC ; 

OUTLINE s- ” i 

strurite ( OUTLINE, 1 ,H, ’Elapsed time = ’,TIME:5:2,’ seconds’ ) i 
SHOWLN ( OUTLINE ) ; 

SHOWLN ( ” ) ; 
uriteln ( LP, OUTLINE ) ; 
uriteln ( LP ) ; 

close ( LP, ’SAVE’ ) 5 

SHOWLN ( ’Test results have been saved in text file ’’utiltest.R’’’ ) ; 
LOITER ( 500 ) 5 
CLEAN_UP_IQ ] 

end . { program TEST_UTILITY_SOFTWARE_UNIT & File ’utiltest.p’ > 
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File ’Prtproca.I* Page 1 
$ page $ < begin File ’Prtprocs.I* > 


Updated @ 23:23:05 Sat 27 Sep 198G 


f Utility Software Unit for HP~9000 Series 200/300/500 Conputers )• 

< NASA/ JSC/ MPAD/TRW : San Wilson > 


procedure PRINT_FIXED_SCALAR ( DESCRIP : DESCRIPSTR ; S : longreal ) ; 
begin 

writeln ( LP, DESCRIP : 22 , S: 1 9 : 1 3 ) ; 
end ; 


procedure PRINT_FIXED_DIAG3X3 < DESCRIP : DESCRIPSTR j D : DIAG3X3 > ; 
var 


j : integer ? 


begin 

write ( LP, DESCRIP:22 ) ? 

for j :« I to 3 do write ( LP, D[j]:19:13 ) ; 

writeln ( LP > ; 

end i 


procedure PRINT_FIXED_EULARR ( DESCRIP : DESCRIPSTR ; E : EULARR ) ; 
var 


j : integer ; 


begin 

write < LP, DESCRIP:22 ) ; 

for j := 1 to 3 do write ( LP, E(jl:19:13 ) s 

writeln ( LP ) ; 

end ; 


procedure PRINT_FIXED_VECTOR ( DESCRIP : DESCRIPSTR ; V : VECTOR ) ; 
var 


j : integer ; 


begin 

write ( LP, DESCRIP:22 ) ; 

for j 1 to 3 do write ( LP, VCj]:19:13 ) 5 

writeln ( LP ) ? 

end ; 


¥085CC3DC 
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File ’Prtprocs.I’ Page Z 
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Updated @ 23:23:05 Sat 27 Sep 1986 


procedure PRINT_FIXED_MAT3X3 < DESCRIP : DESCRIPSTR } M : MAT3X3 ) 
var 


i : integer ; 


begin 

PRI NT_.FI XED_VECTOR ( DESCRIP, MM] ) 5 

for i := 2 to 3 do PRINT_FIXED_VECTOR ( NULLDESCRIP, Mt i 3 ) 5 
end ; 


procedure PRINT_FIXED_SIXVEC ( DESCRIP : DESCRIPSTR j V : SIXVEC ) ? 
var 


j : integer ; 

K : integer ; 

L : LINESTR 5 

begin 
K : = 1 9 
L := ” i 

strurite ( L ,K ,K . DESCRIP: 22 > 5 

for j := 1 to 6 do strurite ( L,K ,K , V[ j ] :9:4 ) ; 
uriteln ( LP, L:76 ); 
end ; 


procedure PRINT_FIXED_SIXPOP ( DESCRIP : DESCRIPSTR 5 S : SIXPOPDEF ) j 
var 


i : integer j 

j : integer ; 


begin 

for i : = 1 to 6 do 
begin 
if i - I 

then urite ( LP, DESCRIP:ZZ ) 
else urite ( LP, * * : ZZ ) 5 
for j := 1 to i do 

write ( LP, S[ TRIANG_INDEX( i , j )] :9: 3 ) j 
uriteln ( LP ) 5 
end ; 

end ; 


¥7CB3DftD3 
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File ’Prtprocs . I ’ Page 3 
$ page $ 


Updated @ Z3:Z3:0S Sat 11 Sep 1986 


procedure PRINT^FLOAT^SCALAR ( DESCRIP : DESCRIP5TR ? S : longreal ) ; 
begin 

uriteln ( LP, DESCRIP: ZZ , TENSPACES , S: 9 ) ; 
end ; 


procedure PRINT^FLOATJIULARR ( DESCRIP : DESCRIPSTR 3 E : EULARR ) ; 
var 


j : integer ; 

begin 

urite ( LP, DESCRIPrZZ ) ; 

for j to 3 do urite ( LP, TENSPACES, Et j ]: 9 ) ; 

uriteln ( LP > ; 
end ; 


procedure PRINT_FLOAT_VECTOR < DESCRIP : DESCRIPSTR ; V : VECTOR ) ; 
var 


j : integer 3 

begin 

urite < LP, DESCRIP : ZZ ) ; 

for j := 1 to 3 do urite ( LP , TENSPACES, V[ j ]: 9 ) ; 
uriteln ( LP ) ; 
end 3 


procedure PRI NTJ r L0AT_J v tAT3X3 ( DESCRIP : DESCRIPSTR 3 M : MAT3X3 ) ; 
var 


i : integer 5 


begin 

PRINT J^LOATJ/ECTOR ( DESCRIP, MU] >3 

for i - 2 to 3 do PRINT_FLOAT_VECTOR ( NULLOESCRIP, MI i 3 ) 3 
end ; 


¥C5ACB02C 
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File ’Prtprocs.I' Page 4 
$ page $ 


Updated & 23 : 23:05 Sat Z7 Sep 198G 


procedure PRINT_FLOflT_SIXPOP ( DESCRIP : DESCRIPSTR 5 
var 


i : integer 5 
j : integer ; 


begin 

for i := 1 to 6 do 
begin 
if i = 1 

then write ( LP , DESCRIP: ZZ > 
else write ( LP , ’’:ZZ ) ; 
for j := 1 to i do 

write ( LP, ’ ’ , SI TRIRNG__INDEX( i , j > ] :8 ) 
uriteln ( LP ) ; 
end j 

end ; 

{ end File ’Prtprocs.I’ > 


: SIXPOPDEF ) 5 
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File ’ Testnath. I ' Page 1 
$ page $ < begin File ' Testniath. I ' > 


Updated @ 23:24:10 Sat 27 Sep 1986 


{ Utility Software Unit for HP-9000 Series 200/300/500 Conputers > 
procedure TEST_UTILMATH_MODULE ! 

< NASA/ JSC/ MP AD/ TRW : San Wilson > 


const 

FLO = 45 s 

var 

i : integer ; 

begin i procedure TEST_UTILMATH_MODULE > 
for i := 1 to 2 do uriteln ( LP ) ; 
uriteln ( LP, ’ TEST_UTILMATH_MQDULE’ :49 ) 5 
for i := 1 to 5 do uriteln ( LP ) ? 


uriteln 

< 

LP, 

’ INK -2.3 ) 

= ’ :FLD, INK -2 

.3 ) : 2 

> ! 





uriteln 

( 

LP, 

'INK -2.0 ) 

= ’ :FLD,INT( -2 

.0 ) : 2 

) ? 





uritel n 

< 

LP, 

’INK -0.3 > 

= ’ :FLD, INK -0 

.3 ) : 2 

) 5 





uriteln 

( 

LP, 

'INK 0.0 ) 

= ’ :FLD, INK 0 

.0 ) : 2 

) ; 





uriteln 

< 

LP, 

'INK 1.3 ) 

= ’ :FLD,INT( 1 

.3 >:2 

) ; 





uritel n 

< 

LP 

) 5 








uriteln 

< 

LP, 

’ FRAC< -2.3 

) = ’:FLO,FRAC< 

-2.3 ): 

5:2 





uriteln 

< 

LP, 

’ FRAC( -2.0 

) = ’ :FLD,FRAC< 

-2.0 ): 

5:2 





uriteln 

( 

LP, 

’ FRAC( -0.3 

) = ’ :FLD,FRAC( 

-0.3 > : 

5:2 





uriteln 

( 

LP, 

’FRAC< 0.0 

) = ’ : FLD, FRAC( 

0.0 ): 

5:2 





uritel n 

( 

LP, 

' FRAC( 1.3 

) = ’ :FLD,FRAC( 

1.3 ): 

5:2 

5 



ur itel n 

< 

LP 

) ; 








ur itel n 

( 

LP, 

' RMQO< -2.8, 

-0.5 ) = ' : FLD, 

RMOD( - 

2-8, 

-0.5 

) : 5: 2 

) 

uriteln 

< 

LP, 

' RMQD( -2.8, 

0.0 ) = * :FLD, 

RMOD( - 

2.8, 

0.0 

) : 5: 2 

) 

uritel n 

< 

LP, 

' RMOD( -2.8, 

0.5 ) = ’ : FLD, 

RMOD( - 

2-8, 

0.5 

) : 5: 2 

) 

uriteln 

< 

LP 

) t 








uriteln 

< 

LP, 

' RMOD( 2.8, 

-0.5 ) = ’ :FLD, 

RMOD( 

2.8, 

-0.5 

) : 5: 2 

) 

uriteln 

< 

LP, 

’RM0D( 2.8, 

0.0 ) = ' : FLD, 

RMOD( 

N3 

00 

0.0 

) : 5: 2 

) 

uriteln 

< 

LP, 

' RM0D( 2.8, 

0.5 ) = ' : FLD, 

RMOD( 

2.8, 

0.5 

) : 5: 2 

) 

uriteln 

< 

LP 

) 5 








uriteln 

( 

LP, 

’ RSIGN( -1.9 

) = ' :FLD,RSIGN( -1.9 

>:2 ) 




uriteln 

( 

LP, 

’RSI6N( 0.0 

) = ' : FLD,RSIGN( 0.0 

>:2 ) 




uriteln 

< 

LP, 

’ RSIGN( 1.9 

> - ’ :FLD,RSIGN( 1.9 

>:2 ) 




uriteln 

< 

LP 

) ! 








uriteln 

< 

LP, 

' ISIGN( -5 ) 

= ' :FLD,ISIGN( 

-5 ) : 2 

) ; 





ur iteln 

< 

LP, 

’ISIGNt 0 ) 

= ’ :FLD, ISIGN( 

0 ):2 

) ; 





uriteln 

< 

LP, 

' ISIGN( 5 ) 

= ’ :FLD, ISIGN( 

5 ) : 2 

) ; 





uriteln 

< 

LP 

) « 
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File ’Testma-th. 

, i * 

Page 

2 



Updated @ 23:24: 10 

Sat 27 

Sep 

$ page $ 













uritel n 

< 

LP, 

’ IMAX( 

-3, - 

4 

> - 

’ :FL.D,IMAX< 

-3, 

-4 ) : 2 

> ; 



uriteln 

< 

LP, 

’ IMAX( 

3, 

4 

> - 

' : FLD, I MAX ( 

3, 

4 ) : 2 

) 5 



uritel n 

< 

LP ) 

1 










uriteln 

< 

LP, 

’ IMIN( 

-3, - 

4 

) • 

* :FLD,IMIN( 

"3, 

-4 >:Z 

) 5 



uriteln 

< 

LP, 

' IMIN( 

3, 

4 

) = 

’ :FLD,IMIN( 

3, 

4 ):2 

) 5 



uritel n 

< 

LP ) 

1 










uriteln 

( 

LP, 

' RMAX( 

-2.9, 

- 

3.9 

) = ’ : FLD,RMAX( 

-2.9, - 

3.9 

> : 5: 2 ) 

5 

ur itel n 

< 

LP, 

’RMAX( 

2.9, 


3.9 

) = ’:FLD,RMAX( 

2.9, 

3.9 

) : 5: 2 ) 

i 

ur i tel n 

< 

LP ) 

5 










uriteln 

< 

LP, 

’RMIN< 

-2.9, 

- 

3.9 

) = ’ : FLD,RMIN( 

-2.9, - 

3.9 

>:5:Z ) 

3 

ur itel n 

< 

LP, 

’ RMIN( 

2.9, 


3.9 

) = ' : FLD,RMIN( 

2.9, 

3.9 

) : 5: 2 ) 

3 

START_NEU_.PAGE 

! 










for i 

■ i 

to 

9 do uriteln 

( 

LP 

) ; 







uriteln ( LP, ’ ANGDEG< ONE > = ’ : FLD, ANGDEG( ONE > : 1 8: 14 ) ? 
uriteln ( LP, ’ ANGRAD( ANGQEG( ONE ) ) - ONE = ’ :FLD, 

( ANGRAQ( ANGDEG< ONE > > - ONE ) : 7 ) ; 
uriteln ( LP ) ? 

{ 1 2 345678901 2 345E789 0 1 2 345678901 2 345 > 
uriteln ( LP, ’ANGDEG< ANG1 < -THREE*TWOPI-HAFPI ) ) = * :FLD, 
ANGDEG<ANG1(-THREE*TU0PI-HAFPI)):17:1Z ) ; 
uriteln ( LP, * ANGDEG< ANG2( THREEUWOPI-HAFPI ) > = ’ :FLD, 
ANGDEG< ANG2( THREE*TUOPI-HAFPI ) ) : 17: 12 ) ; 
uriteln ( LP ) •, 


uriteln ( LP, ’ ANGDEG( ATAN1 ( -SIX , SIX ) ) - * : FLD, 
ANGDEG(ATANH-SIX,SIX>>: 17: 12 ) ; 
uriteln ( LP, ’ ANGDEG( ATANZ( -SIX, SIX > ) - ’ : FLD, 
ANGDEGI ATAN2< -SIX , SIX) ): 17: 1 2 ) ; 
uriteln ( LP ) ; 


uriteln 

< 

LP, 

’ HMS( 

- 36385. 874L0 ) 

uriteln 

( 

LP, 

’ HMS( 

36385. 874L0 ) 

uritel n 

( 

LP 

) ; 


uriteln 

( 

LP, 

’ SECS( 

- 1006. Z5874L0 




SECS( 

- 1006.Z5874L0 

uriteln 

< 

LP, 

' SECS< 

1006. Z5874L0 




SECS( 

1006. Z5874L0 

uriteln 

< 

LP 

) ; 



= ’ : FLD,HMS( -36385. 874L0 ):12:6 ) ; 
= ’:FLD,HMS( 36385. 874L0 ) r 12:6 ) ; 


) = * :FLD, 
):13:6 ) ; 
) = ’ :FLD, 
) : 1 3:6 ) 5 


uriteln ( LP, ' JULI AN_DAYNUM( 1980, 4, 2 ) = ’ : FLD, 
JULIAN_DAYNUM< 1980, 4, 2 ):8 ) , 


START_NEU_PflGE ; 

end ; i procedure TEST„UTILMATH_MODULE > 


< end File ' Testnath. I ’ > 
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File ’Testspif.I’ Page 1 
$ page $ { begin File * Testspif „ I * > 


Updated i 23:24:55 Sat 27 Sep 1986 


f Utility Software Unit for HP-9000 Series 200/300/500 Computers } 
procedure TEST^UTILSPIF_MODULE ; 


{ NASA/ JSC/MPAD/TRW : San Wilson > 


const 

{ 1 2 345678901 2 345678901 2 345G7890 1 2 345678901 2 345 > 

PI * ’Your name* ; 

P2 53 ’Age (years) 1 ? 

P3 05 ’Home town 1 ; 

P4 » ’Direction from here fN,NE,E,SE,S,SW,W,NW>’ ; 

P5 - ’Distance (miles)’ ? 

var 


U1 : WORDSTR 
12 : integer 
W3 : WORDSTR 
W4 : WORDSTR 
F5 : longreal 


integer 

integer 

LINESTR 

CHINPUTREC 


¥F1948314 


Z - 1 



File ’ Testspif . I ’ Page 2 Updated @ 23:24:55 Sat 27 Sep 1986 

$ page $ 

begin { procedure TEST_UTILSPIF_MODULE > 
for n := 1 to 2 do uriteln ( LP ) ; 
writeln ( LP, ’ TEST_UTILSPIF_MODULE ’ :49 ) ? 
for n := I to 5 do uriteln ( LP ) ; 

SOUNO_ALERT ? 

SHOW ( ’Waiting 2 seconds? if you press a key it uill be echoed ’ ) ? 
LOITER ( 2000 ) ? 

WORK := CHAR_INPUT( NOCHWAIT, CHECHO ) ? 

SHOWLN ( ” ) ; 

SOUND_ALERT ; 

SHOW ( 'Waiting indefinitely? press any key to continue ) ? 

OUTLINE ; 

strurite ( OUTLINE , 1 , I , CHAR_INPUT< CHWflIT, NOCHECHO ) ? 

SHOWLN ( OUTLINE ) ? 


W1 

:= RJWORD_INPUT( 

PI, 

'Rumplestiltsk in’ , 15, 15 

) ? 

12 

:= INTEGER_INPUT( 

PZ, 

maxint , 15 

) ; 

W3 

:= RJWORD..I NPUT( 

P3, 

’Brno, Czechoslovakia’, 15, 15 

) ; 

W4 

:» RJWORD_INPUT( 

P4, 

’NE\ 15, 15 

) 1 

F5 

FIXED_I NPUT( 

PS, 

8299.11111877 , 15, 5 

) { 


uriteln < LP, ( ’ 11 ’ +W1 + ’ " ’ > : 1 7 ) ? 
uriteln ( LP, 12:16 ) ? 
uriteln ( LP, < ’"’+W3+”" ): 17 ) ? 
uriteln ( LP, < ’ " ’ +W4+ ’ " ’ ) : 1 7 ) ? 
uriteln ( LP, F5:16:8 ) ? 

for n := 1 to 3 do uriteln ( LP ) ? 

uriteln ( LP, ' START_RANDQM_NUMBER_SEQUENCE ( 1 )’ ) ? 
START_RANDOM_.NUMBER_SEQUENCE ( 1 > ? 
uriteln < LP ) ; 

uriteln ( LP, ’Pseudorandom integers:’ ) ? 
uriteln ( LP ) ; 
for n := 1 to 10 do 

uriteln ( LP, RflNDOM_INTEGER: 10 ) ? 

for n := 1 to 3 do uriteln ( LP ) ? 

uriteln ( LP, ’ START_RANDOM_NUMBER_SEQUENCE ( 2147483646 )’ ) ? 
START_RRNDOM_NUMBER_SEQUENCE ( 2147483646 ) ? 
uriteln ( LP > ? 

uriteln ( LP, ’Pseudorandom integers:’ ) ? 
uriteln ( LP ) ? 
for n : = 1 to 10 do 

uriteln ( LP, RANDQM_INTE6ER: 10 ) ? 

START_NEW_PAGE ? 

end ? { procedure TEST_UTILSPIF_MODULE > 

{ end File ’Testspif. I’ } 


¥761D65BD 
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File ’ TeatveMq. I ' Page 1 Updated @ Z3:2G:08 Sat 27 Sep 198G 

$ page $ < begin File ’ Testvenq. I ’ > 

f Utility Software Unit for HP - 9000 Series 200/300/500 Conputers 1 
procedure TEST_UTILVEMQ_MODULE ? 

< NASA/ JSC/MPAD/ TRW : San Wilson > 


var 


i : integer ; 


begin 

for i : = 1 to 2 do uriteln ( LP ) ; 
uriteln < LP, * TE5T_UTI LVEMQ_MODUL.E * : 49 ) ? 
for i := 1 to 5 do uriteln < LP > s 

TEST_UTILVEMQ_VECTOR_FUNCTIONS ? 

TEST_UTI L VEMQ„MATRI X_FUNCTI QNS ; 
TEST_UTILVEMQ_IMATQ_FUNCTION ; 
TEST_UTILVEMQ_EULER_QUAT_FUNCTIONS ■, 
TEST_UTILVEMQ_QUAT_ROT_FUNCTIONS ; 

TEST_UTI L VEMQ_UNI QUAT_FUNCTI ON ; 
TE5T_UTILVEMQ_MATRI X_DI AGONAL I ZATI ON 5 

end i 


¥E73FF0DF 
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File ’ Testvenq. I ’ Page Z 
$ page $ 


Updated @ Z3:Z6:08 Sat 21 Sep 198G 


procedure TEST_UTILVEMQ_VECTOR_FUNCTIONS 5 
var 

i : integer 5 
j : integer ; 

begin 

PRINT_FIXED_VECTOR ( ’V = ’,V ) ; 
uriteln ( LP ) ; 

PRINT_FIXEO_VECTOR ( ’W =\U > ; 
uriteln ( LP ) ; 

PRI NT_F I XEQ_SCAL AR ( ’DOTP(V.U) =’,D0TP(V,W) ) ; 
uriteln ( LP ) ; 

PRINT_FIXED_SCALAR ( ’VMAG(V) = \VMAG<V> ) 5 
uriteln ( LP ) 5 

PRINT_FIXED_VECTOR ( ’SXV<TLIQ,V) «• , SXV( TWO, V ) ) 5 
uriteln ( LP ) ; 

PRINT_FIXEO_VECTOR ( ’CRSP(V,LI) =’,CRSP(V,W) ) 5 
uriteln ( LP ) j 

PRI NT_F I XED_VECTQR ( ’VDIF(V,U) »’,VDIF(V,U) ) ; 
uriteln < LP ) 5 

PRINT_FIXED_VECTQR ( ’VSUM(V.U) = \VSUM(V,U> ) ; 
for i := 1 to 5 do uriteln ( LP ) 5 

{ 1 Z345G78901 Z 34587890 1 Z > 
urite ( LP, ’ D =’ ) ; 

for j := 1 to 3 do urite ( LP, DC j] : 19:13 ) ; 
for i := 1 to Z do uriteln ( LP ) 5 
PRI NT_F I XED_VECT OR ( ’VXD(V.D) =\VXD(V,D> ) 5 
for i := 1 to 5 do uriteln ( LP ) ; 

PRINT_FIXED_MAT3X3 ( ’ M = ’ ,M ) ; 
uriteln < LP ) ; 

PRINT_FIXED_VECTOR ( ’VXM(V.M) = \VXM<V,M) ) ; 
uriteln ( LP ) j 

PRINT_FIXED_VECTQR ( ’ VXMT( V , M) = ’ , VXMT< V,M) ) ; 

START_NEU_PAGE ; 
end ; 


¥7DFA6ZBA 
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File * Test vemq. I ’ Page 3 Updated @ Z3:Z6:08 Sat Z7 Sep 198G 

$ page $ 

procedure TEST_UTILVEMQ_MATRIX_FUNCTIONS 5 
var 

i : integer ; 

begin 

for i : = 1 to 9 do uriteln ( LP ) ; 

PRINT_FIXE0_MAT3X3 ( ’L =’ ,L ) ; 
uriteln ( LP ) ; 

PRINT_FIXED_.MAT3X3 ( 1 MDIF(L,M> = \MDIF(L,M> ) ; 
uriteln ( LP ) j 

PRINT_FIXE0„MAT3X3 ( 'MSUM(L.M) = \MSUM<L,M> ) ; 
uriteln < LP ) j 

PRINT_FIXED_MAT3X3 ( ’MXM(L.M) = \MXM(L,M) ) ; 
uriteln < LP ) j 

PRINT_FIXED_MAT3X3 ( ’MXMT(L.M) = \MXMT(L,M> ) 5 
uriteln ( LP ) 5 

PRINT_FIXED_MAT3X3 ( ’ MTXM( L ,M) = \MTXM(L,M> ) 5 
uriteln ( LP > ; 

PRINT_FIXED_MAT3X3 ( = \MINV(M> ) ? 

uriteln ( LP ) j 
N := MXM< M , MINV( M ) ) ; 

PRINT_FIXED_MAT3X3 ( ' N - MXM( M,MINV( M) > = \N > 5 
uriteln ( LP ) ; 

PRINT_FL0AT_MAT3X3 ( ’ MDIF< N , IDN3X3 ) «• ,MDIF( N.IDN3X3) ) ; 

ST ART_NEU_P AGE ; 
end ; 


¥BAG9G749 
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File ’ Testvenq. 1 ’ Page 4 
$ page $ 


Updated @ Z 3:26:08 Sat Z7 Sep 1986 


procedure TEST_UTILVEMQ_IMATQ_FUNCTION ; 
var 


i : integer ; 


begin 

for i := 1 to 9 do uriteln < LP ) ; 


X := CRSPOJ.V) ; 

PRINT_FIXED_VECTOR ( ’X = CRSP(W.V) =’,X ) 5 


uriteln 

< 

LP 

) 5 








< 12345678901 2345678901 2 > 




uriteln 

< 

LP, 

1 

NI 31 = SXV( 

0NE/VMAG( X 

). 

X )’ ) ; 

uriteln 

< 

LP, 

» 

Nil] - SXV< 

ONE/VMAG< U 

>, 

U )’ ) 5 

uriteln 

< 

LP, 

« 

Nt 2] = CRSP( 

Nt 31 , Nt 1 1 

)' 

) ; 


uriteln ( LP ) ; 

Nt 3] :* SXV< 0NE/VMAG( X ), X ) ; 

Nil] := SXV< 0NE/VMAG( U ), U ) ; 

Nl 2] := CRSP( N[ 3J , Nt 1 ] ) ,■ 

PRINT_FIXED_MAT3X3 ( ' N = ' ,N > 5 
uriteln ( LP ) j 

<1 2345678901 Z34567890I 2 > 

uriteln ( LP, ’ Q - IMATQt N ) ’ ) 5 

uriteln ( LP ) 5 
Q := IMATQt N ) 5 

PRINT„FIXED_SCALAR < ’Q.S =’ ,Q.S ) 5 
PRINT_FIXED_VECTOR ( ’Q.V =’,Q.V ) 5 
uriteln ( LP ) ; 

< 1 2345678901 2345678901 2 > 

uriteln < LP, ’ P = QCXQ( Q, Q )’ ) ; 

uriteln ( LP ) ; 

P := QCXQ< Q, Q ) ; 

PRINT_FIXED_SCALAR ( ’P.S -• ,P.S ) j 
PRINT_FIXEO_VECTQR ( ’P.V -',P.V ) ; 
uriteln ( LP ) 5 

PRI NT_FLQAT_SC AL AR ( ’ONE - P.S =’,QNE-P.S ) ; 
PRINT_FLOAT_VECTOR ( ’ P.V =’,P.V ) ; 
uriteln ( LP ) ; 

N := MXMT( N, N > s 

PRI NT_F I XED_MAT3X3 ( *N = MXMT( N, N ) -• ,N > ; 
uriteln ( LP ) s 

PRI NT_FLQAT_MAT3X3 ( ’MDIF( N.IDN3X3) =’ ,MDIF( N, IDN3X3) ) 5 

START_NEU_PAGE j 
end 1 


Z . 
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File ’ Testvenq. I ’ Page 5 
$ page $ 


Updated @ 23:26:08 Sat 27 Sep 1986 


procedure TEST_UTILVEMQ_EULER_QUflT_FUNCTIONS ; 
var 


i : integer ; 


begin 

for i := 1 to 9 do uriteln ( LP ) 5 


PRINT_FIXED_EULflRR ( ’PRY -’.PRY ) i 
uriteln < LP ) ; 

PRINT_FIXED_EULARR ( ’RPR =’ ,RPR ) ? 
uriteln < LP ) ; 

< 1 2 345678901 2 34587890 1 2 > 

uriteln < LP , ’ P = PRYQ( EULRADI PRY ) )’ ) ; 

uriteln ( LP, ’ Q = RPRQ( EULRAD( RPR ) )’ ) ; 

uriteln ( LP ) ; 

P := PRYQ( EULRADC PRY ) ) i 
Q := RPRQ( EULRAD( RPR) ) ; 


PRI NT_F I XED_SCflLAR 

( 

’P.S ,P.S 

) 

5 

PRINT_FIXED_VECTOR 

( 

'P.V -• ,P.V 

) 

5 

uriteln ( LP ) s 





PRI NT_FI XED_SCflLRR 

< 

’Q.S -’ ,Q.S 

) 

5 

PRINT_FIXED_VECTOR 

< 

’Q.V -• ,Q. V 

) 

5 


uriteln < LP ) 5 

PRINT_FIXED_EULARR ( ’ EULDEG( QPRY( P ) ) =’,EULDEG< QPRY( P > > > ; 
uriteln ( LP ) ; 

PRI NT_FI XED_EULARR ( ’EULDE6( QRPR( Q ) ) =’ ,EULDEG( QRPR( Q > ) ) ; 
For i := 1 to 5 do uriteln ( LP ) ; 


PRI NT_F I XED_EULARR ( ’PYR =’ ,PYR ) ; 
uriteln ( LP ) ; 

PRINT_FIXED_EULARR ( ’ YRY =’ ,YRY > ; 
uriteln ( LP ) ; 

{ 1 2 345678901 2 345878901 2 } 

uriteln ( LP, ’ P = PYRQ( EULRAD( PYR ) ) ’ 

uriteln ( LP, ’ Q - YRYQ( EULRAD( YRY ) >’ 


uriteln < LP ) ; 

P := PYRQ( EULRftD(PYR) ) i 
Q := YRYQ(EULRRD( YRY)) ; 

PRI NT_FI XED_SC ALAR ( ’P.S -’ ,P.S ) j 
PRINT_FIXED_VECTOR ( ’P.V =’ ,P.V > 5 
uriteln < LP ) j 

PRINT_FIXED_SCALAR ( ’Q.S ,Q.S > ; 

PRINT_FIXED_VECTOR < ’Q.V -• ,Q.V ) 5 
uriteln ( LP ) ? 

PRI NT_FI XED _EULARR ( ’ EULDEG( QPYR( P ) ) »’ ,EULDEG( QPYR( P 
uriteln ( LP ) i 

PRINT. FIXED_EULRRR ( *EULDEG( QYRY( Q ) ) =’,EULDEG( QYRY( Q 


) 1 
) 5 


) ) 
) ) 


STRRT_NEW_PflGE ; 
end ; 
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File ’ Testvenq. I ’ Page G 
$ page $ 


Updated @ 23:26:08 Sat 27 Sep 1986 


procedure TEST_UTILVEMQ_QUAT_ROT_FUNCTIQNS ; 
var 


i : integer 5 


begin 

for i := 1 to 9 do uriteln ( LP ) 5 

R := QCXQ< P, Q ) 5 

{ 1 2 345678901 2 34567890 1 2 > 

uriteln ( LP, * R = QCXQ< P, Q ) ’ ) 5 

uriteln ( LP ) j 

PRI NT_FIXED_SC ALAR ( ’R.S =’,R.S ) 5 
PRINT_FIXED_VECTOR ( ’R.V =’,R.V ) ; 
uriteln ( LP ) 5 

R := QXQC( P, Q ) ; 

{ 123456789012345678901 2 > 

uriteln ( LP, • R = QXQC( P, Q )’ ) ; 

uriteln ( LP ) 5 

PRI NT_FI XED_SC ALAR ( ’R.S =’,R.S ) 5 
PRINT_FIXED_.V ECTOR ( ’R.V *’,R.V ) ; 
uriteln ( LP ) 5 


R :* QXQ( P, Q > ; 

{12345678901234567890121 

uriteln ( LP, ’ R = QXQ( P, Q ) ’ ) ; 

uriteln ( LP ) ; 

PRINT_FIXED_SCALAR ( ’R.S =’,R.S ) ; 

PRINT_FIXED_VECTOR ( ’R.V =’ ,R.V ) ; 
uriteln ( LP ) 5 


PRINT_FIXED_MAT3X3 ( ’ QMAT( R ) =’ , QMAT( R ) ) ; 
uriteln ( LP ) i 

N := MDIF( QMAT(R), MXM( QMAT ( P ) , QMAT ( Q ) > ) 5 
{ 1 2345678901 2345678901 2 1 

uriteln ( LP, ’ N - MDIF< QMAT(R), * , 

’ MXM( QMAT ( P ) , QMAT ( Q ) ) )’ ) 5 

uriteln ( LP ) 5 

PRINT_FL0AT_MAT3X3 ( ’N N ) 5 
uriteln ( LP ) 5 


PRI NT_F I XE D_.V ECTOR ( ’ROT(V.Q) =’,ROT(V,Q) ) 5 
uriteln ( LP ) ; 

PRINT_FIXED_VECTOR ( ’IROT(V,Q> = \IR0T(V,Q> ) s 
uriteln ( LP ) s 

X := VDIF( V, IR0T< R0T( V , Q) , Q) ) ; 

{ 1 2 345678901 2 34567890 1 Z 1 

uriteln ( LP, ’ X = VDIF1 V, IR0T( ROT< V,Q> ,Q> )’ 

uriteln ( LP ) 5 

PRI NT„FLOAT„V ECTOR ( ’X =’,X > i 

START_NEU_PAGE } 
end ; 


; 
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File * Testvemq. I ’ Page 7 Updated 6 Z3:Z6:08 Sat Z7 Sep 1986 

$ page $ 

procedure TEST_UTI L VEMQ_UNI QUOT_FUNCTI ON 5 
var 


i : integer ! 


begin 

for i := 1 to 8 do uriteln < LP > 5 

P.S := PI * R.S ; 

P.V := SXV< PI, R.V ) 5 
Q := UNIQUflK P ) 

i 1 Z 34567890 1 Z 345678901 Z > 

uriteln ( LP, ’ P.S = PI * R.S’ ) 5 

uriteln < LP, ’ P.V = SXV< PI, R.V )’ ) ; 

uriteln ( LP ) ; 

PRINT_FIXED_SCALflR ( ’P.S =’,P.S ) j 
PRINT_FIXED_VECTOR ( ’P.V =’,P.V ) , 
uriteln ( LP ) ; 

{ 1 Z34S678901 Z345678901 Z 1 

uriteln ( LP, ’ Q = UNIQUAK P >’ > ; 

uriteln ( LP ) 5 

PRINT_FIXED_SCALOR ( ’Q.S =’,Q.S ) ; 

PRINT_FIXED_VECTOR < ’Q.V =’,Q.V ) ; 
uriteln ( LP ) ; 

R := QXQC( Q, Q ) i 

{ 1 Z 345678901 Z 34567890 1 Z > 

uriteln ( LP, ’ R = QXQC( Q, Q )’ ) 5 

uriteln ( LP ) ; 

PRI NT_FL00T_SCflLAR ( ’ONE - R.S =’,ONE-R.S ) ; 
PRINT_FLOflT_VECTOR ( ’R.V =’,R.V ) 5 
for i := 1 to 5 do uriteln < LP ) ; 

end ; 


¥04631803 
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File ’ Testvemq. I ’ Page 8 


Updated @ 23:26:08 Sat 27 Sep 1986 


$ page $ 

procedure TEST_UTI L VEMQ_MATRI X_DI AGONAL I ZATION 5 
var 


i 

MPB 

NERTENS_B 

NERTENS_P 

RPRBP 

RPRPB 


integer 

MAT3X3 

MAT3X3 

MAT3X3 

EULRPR 

EULRPR 


begin 

RPRPB := RPR ; 

PRINT_FIXED_EULARR ( ’RPRPB =’ .RPRPB ) ; 
uriteln < LP > ; 

NERTENS_P := K 5 

PRINT_FIXE0_MAT3X3 < ’ NERTENS_P =’,NERTENS_P ) \ 
uriteln ( LP ) ; 

MPB :=■ QMAT( RPRQ( EULRADI RPRPB > > ) 5 
NERTENS_B := MTXM( MPB, MXM( NERTENS_P, MPB ) ) ? 

< 1 2 34567890 1 2 34567890 1 2 > 

uriteln ( LP, • MPB = QMATI RPRQ< EULRADI RPRPB )))’ ) ; 

uriteln ( LP , ’ NERTENS_B - MTXM( MPB,MXM( NERTENS, P , MPB))’ ) s 

uriteln ( LP ) ; 

PRINT, FI XED„MAT3X3 ( ’ NERTENS_B = ’ ,NERTENS_B ) ; 
uriteln ( LP ) ; 

Sill := NERTENS_BC 1,11 ; 

SI 2] :« ( NERTENS_Bt 2,13 + NERTENS_BI 1,21 ) / TWO ; 

SI 3] := NERTENS_BI2 ,2] 1 

SI 41 := ( NERTENS_BI 3 , 1 J + NERTENS_BI 1 , 31 ) / TWO 5 

St 51 :*= ( NERTENS_BI 3,21 + NERTENS_BI Z , 31 ) / TUO 5 

SI 6 J := NERTENS,BI 3 , 31 ; 

uriteln < LP, ’S - NERTENS_BI 1,11, ’:70 ) i 

uriteln < LP, ’ NERTENS_BI 2,11, NERTENS_BI 2 , 21 , ’:70 ) 5 

uriteln ( LP, 1 NERTENS_BI 3,11, NERTENS_Bt 3,21, NERTENS_Bt 3 , 31 ’ : 70 ) j 

uriteln ( LP ) 5 

DIAGONALIZE ( S, 1.0L-8, E, N > ) 

{ 1 2 345678901 2 345678901 2 > 

uriteln ( LP, 1 DIAGONALIZE ( S, 1.0L-8, E, N )’ ) 5 

uriteln < LP ) ; 

PRI NT_FI XED_D J A63X3 < ’E =’ ,E ) 5 
uriteln ( LP ) ; 

RPRBP := EULDEGI QRPR( I MATCH N ) > ) ; 

{ 1 Z345678901 2345678901 2 > 

uriteln ( LP, ’ RPRBP = EULDEGI QRPRI IMATQ< N ) ) )’ ) ; 

uriteln I LP ) ; 

PRINT, FI XED_EULARR ( ’RPRBP =’ .RPRBP ) ; 


START_NEU_PA6E ; 
end ; 


< end File ’Testvenq.I’ > 
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Z . B 


File ’ Teststat . I ' Page 1 

$ page $ { begin File ' Teststat . I ’ > 


Updated @ 07:22:55 Mon 29 Sep 1986 


{ Utility Software Unit for HP-9000 Series 200/300/500 Computers > 
procedure TEST_UTILSTAT_MODULE 5 

{ NASA/JSC/MPAD/TRW : Sam Wilson > 


var 


i : integer 5 


begin 

for i := 1 to 2 do uriteln ( LP ) 5 
uriteln ( LP, ’ TEST_UTILSTAT_MODULE ’ : 49 ) 5 
for i :* 1 to 5 do uriteln ( LP ) ; 

RUNNUM : = 1 ; 

START_RANDOM_NUMBER_SEQUENCE ( 454387819 ) 5 
TEST_UTILSTAT_UNIFORM_RANDOM_SCALAR._FUNCTION 5 
TEST_UTILSTAT_GAUSSIAN_RANDOM_SCALAR_FUNCTION ; 
TEST_UTILSTAT_SIXTUC_MATRI X_F UNCTION ? 
TEST_UTILSTAT_ 6 AUSSIAN _RANDOM„SIXVECTOR_FUNCTION 5 

end ; 
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procedure TEST_UTILSTAT_UNIFQRM_RANQOM_SCALAR_FUNCTIQN 5 
const 


Updated @ 07 : Z Z : 55 Mon Z9 Sep 1986 


NUMVALS - 1000 ; 

UNCERT = FIVE ; 

CLASS =■ CLASSARR t 


CLASSREC 

[ 

VUB 

-5.0L0 

> 

CDF 

0.0L0 

] 


CLASSREC 

I 

VUB 

-4.0L0 

» 

CDF 

0. 1L0 

1 


CLASSREC 

I 

VUB 

-3.0L0 

» 

CDF 

0.ZL0 

] 


CLASSREC 

[ 

VUB 

-Z.0L0 

» 

CDF 

0.3L0 

] 


CLASSREC 

[ 

VUB 

-1 .0L0 

> 

CDF 

0.4L0 

I 


CLASSREC 

t 

VUB 

0.0L0 

» 

CDF 

0.5L0 

J 


CLASSREC 

[ 

VUB 

1 . 0L0 

» 

CDF 

0.GL0 

] 


CLASSREC 

[ 

VUB 

Z.0L0 

» 

CDF 

0.7L0 

I 


CLASSREC 

[ 

VUB 

3.0L0 

» 

CDF 

0.8L0 

I 


CLASSREC 

[ 

VUB 

4.0L0 

» 

CDF 

0.9L0 

] 


CLASSREC 

[ 

VUB 

5.0L0 

> 

CDF 

1 . 0L0 

] 

i 


var 


A 

E 

h 

k 

L 

M 

n 

DISTRIB 

X 

R 


integer 

integer 

integer 

integer 

LINESTR 

integer 

integer 

array [ 0 

longreal 

longreal 


. 10 ] of integer ; 
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begin { procedure TEST_UTILSTAT_UNIFORM_RANDOM_SCALAR_FUNCTIQN > 
SUPPRESS.CURSOR } 

SHOULN ( ” ) 5 

for k := 0 to 10 do DISTRIBfkJ := 0 ; 
for n := 1 to NUMVALS do 
begin 

if ( n nod 100 ) =0 then 
begin 
L := ” ; 

strurite ( L, 1 ,M, ’UNI F0RM_RAND0M .SCALAR ’,n:5 ) ; 

CLEAR_LINE ; 

SHOW ( L ) ? 
end ; 

X := UNIFORM_RANDOM_SCALAR( UNCERT ) ; 
for k : = 0 to 10 do 

if X <= CLASS! k ] . VUB then 

DISTRIB! k ] := DISTRIBE k ] + 1 ; 

end ? 

SHOULN ( ” ) j 
RESTORE.CURSOR ; 

uriteln ( LP, ’Test UNIFORM_RANDOM_SCALAR Function ' :57 ) ; 
for h := 1 to 8 do uriteln < LP ) j 

uriteln ( LP, ’ CUMULATIVE DISTRIBUTION OF 40, NUMVALS: 4 , 

’ PSEUDORANDOM NUMBERS’ ) ; 
uriteln ( LP, ’FROM A’:42 ) 5 

uriteln ( LP, ’UNIFORMLY DISTRIBUTED POPULATION’ : 55 ) s 

uriteln ( LP, ’HAVING ZERO MEAN’:47 ) ; 

uriteln < LP, ’( UNCERTAINTY = ’ :44,UNCERT:4: 1 , ’ )’ ) 5 

uriteln ( LP ) 5 

uriteln < LP ) ; 

uriteln ( LP, ’ CLASS ACTUAL EXPECTED ACTUAL /’:64 > 5 

uriteln ( LP, ’UPPER BOUND DISTRIBUTION DISTRIBUTION EXPECTED’ :64 ); 

uriteln ( LP ) ; 
for k := 0 to 10 do 
begin 

A := DISTRIBIk] ; 

E := round! NUMVALS * CLASS! k I. CDF ) ; 
if A = E 

then 

R := ONE 
else 

if E = 0 

then R := 99999.9999 
else R := A / E 5 

uriteln ( LP, CLASS! k ] . VUB: 20: 1 , A: 14, E: 14,R: 1 5:4 ) ; 
end ; 

START_NEU_PAGE ; 

end 5 < procedure TEST_UTILSTAT_UNIFORM_RANDOM_SCAL AR_FUNCTIQN > 
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procedure TEST„UTILSTAT_GAUSSIAN__RANDGM_SCALAR_ 
const 


NUMVALS = 1000 5 

SIGMA - TEN s 


CLASS = CLASSARR [ 


CLASSREC 

C 

VUB 

-ZS.0L0 

3 

CDF 

CLASSREC 

[ 

VUB 

-Z0.0L0 

3 

CDF 

CLASSREC 

[ 

VUB 

-15.0L0 

3 

CDF 

CLASSREC 

I 

VUB 

-10.0L0 

3 

CDF 

CLASSREC 

f 

VUB 

-5.0L0 

3 

CDF 

CLASSREC 

[ 

VUB 

0.0L0 

> 

CDF 

CLASSREC 

I 

VUB 

5.0L0 

3 

CDF 

CLASSREC 

f 

VUB 

10.0L0 

3 

CDF 

CLASSREC 

[ 

VUB 

15.0L0 

3 

CDF 

CLASSREC 

[ 

VUB 

Z0.0L0 

3 

CDF 

CLASSREC 

[ 

VUB 

Z5.0L0 

3 

CDF 


var 



A 

E 

h 

k 

L 

M 

n 

OISTRIB 

X 

R 



integer 

integer 

integer 

integer 

LINESTR 


integer 
integer 
array [ 0 
longreal 
longreal 


. 10 ] of 


integer 


FUNCTION ! 


0.00GZ1L0 ] , 

0. 0ZZ75L0 ] , 
0.06681L0 1 , 

0. 158GGL0 1 , 

0. 30854L0 ] , 

0. 50000L0 ] . 
0.G914GL0 1 , 
0.84134L0 1 , 
0.93319L0 I , 

0. 977Z5L0 ] , 

0. 99379L0 ] ] ; 
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begin < procedure TEST_UTILSTAT_GAUSSIAN_RANDQM_SCALAR FUNCTION > 
SUPPRESS_CURSOR j 
SHOULN < ” ) ; 

for k := 0 to 10 do DISTRIBfk] := 0 ; 
for n 1 to NUMVALS do 
begin 

if ( n nod 100 > = 0 then 
begin 
L := ” ; 

strurite ( L, 1 ,M, ’GAUSSIAN_RANDOM SCALAR ’,n:5 > j 
CLEAR_LINE j 
SHOW ( L ) ; 
end ; 

X := GAUSSI AN_RANDOM_SCALAR( SIGMA ) 5 
for k := 0 to 10 do 

if X O CLASSC k ] . VUB then 

DISTRIBfk] := DISTRIBfk] + 1 j 

end ; 

SHOULN ( " ) 5 
RESTORE..CURSQR ; 

for h := 1 to 7 do uriteln ( LP ) ; 

uriteln ( LP, 'Test GAUSSI AN_RANDOM_SCALAR Function ’ :57 > } 
for h := 1 to 8 do uriteln ( LP > ; 

uriteln ( LP, ’ CUMULATIVE DISTRIBUTION OF ’ :40,NUMVALS:4, 

’ PSEUDORANDOM NUMBERS’ ) ; 
uriteln < LP, ’FROM A’:42 ) ; 

uriteln ( LP, ’NORMALLY DISTRIBUTED POPULATION’ :55 ) ; 

uriteln ( LP, ’HAVING ZERO MEAN’:47 ) 5 

uriteln ( LP, ’( SIGMA = ’ :41 ,SIGMA:4: 1 , ’ )’ ) j 

uriteln ( LP ) ; 

uriteln < LP ) 5 

uriteln ( LP, ’ CLASS ACTUAL EXPECTED ACTUAL /':G 4 )j 

uriteln ( LP, 'UPPER BOUND DISTRIBUTION DISTRIBUTION EXPECTED’ :G4 >5 

uriteln ( LP ) j 
for k := 0 to 10 do 
begin 

A := DISTRIBfk] ; 

E := roundf NUMVALS # CLASSm.CDF ) s 
if ft = E 

then 

R := ONE 

el 6 e 
if E = 0 

then R := 99999.9999 
else R := A / E i 

uriteln < LP, CLASSIk] . VUB:20: 1 ,A: 14, E: 14, R: 15:4 ) ; 
end ; 

ST ART_NEW_P AGE 5 

end ; < procedure TEST_.UTILSTAT_GAUSSIAN_RANDOM_SCALAR_FUNCTION > 
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procedure TEST_UTILSTAT_SIXTUC_MATRIX_.FUNCT10N 5 
const 


SIXPOPIN = SIXPOPDEF [ 


1 .00000L0, 
0.48650L0, 
0. 53460L0, 
0.47810L0, 
0. 19910L0, 
0.46049L0, 


1 . 00000L0, 
0. 69872L0, 
-0.99618L0, 
-0.661G5L0, 
-0.7781 3L0, 


1 . 00000L0, 
-0.70584L0, 
-0. 6270GL0, 
-0.87129L0, 


1 . 00000L0 , 
0.66691L0, 
0.78915L0, 


1 . 00000L0, 

0.72009L0, 


var 


h 

i 

ij 

j 

k 

ki 

kj 

SIXTUC 

SIXPOPOUT 


integer ; 
integer ; 
integer 5 
integer ; 
integer ; 
integer ; 
integer ; 
TRIANG6X6 ; 
SIXPOPDEF : 


1 . 00000L0 1 ; 
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begin i procedure TEST_UTILSTAT_SIXTUC_.MATRIX_FUNCTION > 

for h :* 1 to G do uriteln ( LP ) ; 

uriteln < LP, ’Teat SIXTUCJ 1 ATRIX Function’ :53 ) j 

for h := 1 to 7 do uriteln ( LP ) 5 

PRI NT_F I XE D_S I XPOP < ’SIXPOPIN =•’, SIXPOPIN ) 5 

for h := I to 2 do uriteln ( LP ) ; 

try 


SIXTUC := SIXTUC_MATRIX( SIXPOPIN ) 5 
uriteln < LP, ’ SIXPOPOUT =’ : ZZ , 

’ T * M , uhere M is SIXTUCJIATRIXI SIXPOPIN )’ ) 
uriteln ( LP, ”:ZZ, 

’ and T is the transpose of M. ’ ) 5 

for h := 1 to Z do uriteln ( LP ) 5 
for i := 1 to G do 


for j := 1 to i do 
begin 

ij := TRI ANG_INDEX< i, j ) ; 
SIXPOPOUTI i j ] := ZERO 
for k := 1 to j do 
begin 

ki := TRIANG_INDEX( k, i ) ; 
kj := TRIANG_INDEX( k, j ) 5 
SIXPOPOUTI ij] := SIXPOPOUTI ij ] + 


end 5 

end ; 

PRI NT_F I XE D_S I XP OP ( ’SIXPOPOUT = 
for h :■= I to 2 do uriteln ( LP ) 
for i := 1 to 6 do 


SIXPOPOUT > 


SIXTUCIkil 
SIXTUCIk j ] 


# 

i 


for j :* 1 to i do 
begin 

ij TRIANG_INDEX< i, j ) ? 

SIXPOPOUTI: ij] := abs( SIXPOPOUT! ij ] - SIXPOPIN! ij] > ; 
end ; 

PRI NT _F LGAT_5 I XP OP ( ’ I SIXPOPOUT-SIXPOPIN I =»* , SIXPOPOUT ) ; 
for h := 1 to Z do uriteln ( LP ) 5 


1 


recover 

uriteln ( LP, ’escapecode = ’ , escapecode: 1 ) j 
START_NEW_PAGE ? 

end s i procedure TEST _UTILSTAT_SIXTUC_MATRIX_, FUNCTION > 
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procedure TEST_UTILSTAT_GAUSSI AN_RANDOM_.SIXVECTOR„FUNCTION j 


const 


MAXPOPS = 3 ; 

NUMVALS = 1000 5 

type 

POPIDNUM = 1 . . MAXPOPS 5 

POPIDTEXTARR = array [ POPIDNUM 3 of LINESTR 5 
SIXPOPDEFARR - array I POPIDNUM 3 of SIXPOPDEF 5 

const 

POPIDTEXT = POPIDTEXTARR [ 

LINESTR I ’ ASTP / Apollo STDN Z-Station Estimation Error ' 1, 

LINESTR [ ’PAIDS / Long-Range Stationkeep uithout TIC ; 0.5 deg Deadbands' 1, 

LINESTR [ 'RAIDS / Long-Range Stationkeep uith TIC ; 3.0 deg Deadbands ' 33; 

SIXPOFIN - SIXPOPDEFARR l 


{ ASTP / Apollo STDN Z-Station Estimation Error > 


< PAIDS / Long-Range Stationkeep uithout TIC i 0.5 deg Deadbands > 


0. 06300L0, 

0. 0S77GL0, 0.07300L0, 

-0. Z077GL0, -0. 360G9L0, 0.0ZG00L0 3 , 


{ PAIDS / Long-Range Stationkeep uith TIC ] 3.0 deg Deadbands > 


0. 1 13G3L0, 

0.7Z009L0, 0.41G89L0 3, 


SIXPOPDEF I 

75.30095L0, 
0. 48G50L0, 
0.534G0L0, 
-0.47810L0, 
-0. 19910L0, 
-0. 46049L0, 

SIXPOPDEF I 

10. 10000L0, 
0. 3759GL0, 
-0. 19199L0, 
-0.40541L0, 
0.55319L0, 
-0.34093L0, 

SIXPOPDEF [ 

G. 90000L0, 
0. 43070L0, 
0. 3007GL0, 
-0.4S684L0, 
0.51904L0, 
-0.07188L0, 


¥E334C5B4 


179. 9058GL0, 
0. 6987ZL0, 
-0.99618L0, 
-0.GG1G5L0, 
-0.7781 3L0, 


40. 30000L0, 
0. 1G483L0, 
-0. G5ZZ6L0, 
-0.051 93L0, 
0. Z7385L0, 


27. 80000L0, 
0.09788L0, 
-0.36040L0, 
0. 51485L0, 
0.0SS97L0, 


79 . 85549L0, 
-0. 70584L0, 
-0. GZ70GL0, 
-0.871Z9L0, 


1 1 . 90000L0 , 
-0.08834L0, 
-0. 35843L0, 
0. 18710L0, 


G. 90000L0, 
0. 33187L0, 
0 . 3Z888L0, 
0.3G320L0, 


0. 1899ZL0, 
0.GGG91L0, 
0.78915L0, 


0. 04Z00L0, 
0. 10399L0, 
0.0G798L0, 


0.0G300L0, 

-0.01471L0, 


0.02 400L03 3 ; 
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var 


COVAROUT 

h 

i 

ii 

ij 

j 

j j 
k 
L 
M 

populat ion 

SIXTUC 

n 

SIXPOPOUT 

V 


array [ 1..6, 1..6 1 of longreal ; 

integer ; 

integer ; 

integer ; 

integer ; 

integer ; 

integer ; 

integer ; 

LINESTR s 
integer s 
POPIDNUM ; 

TRIANG6XG ? 
integer i 
SIXPOPDEF ; 

SIXVEC i 


begin { procedure TESTJJTILSTATJ3AUSSIAN_RAND0M_SIXVECTGR_FUNCTI0N } 
for population := 1 to 3 do 
begin 

SUPPRESS_CURSOR ; 

SHOUILN ( ” ) 5 

for h := 1 to 6 do uriteln ( LP ) ; 

uriteln ( LP, ’Test 6AUSS1AN_RAND0M_SIXVECT0R Function’ :59 ) ; 
for h := 1 to 3 do uriteln ( LP ) ; 

uriteln < LP, TENSPACES,’ ’ .POPIDTEXTipopulationJ ) 5 
for h := 1 to 3 do uriteln ( LP ) ; 

PRINT_FIXED_SIXPOP ( 'SIXP0P1N =’ , SIXPOPINl populat ion] ) } 
for h := 1 to Z do uriteln ( LP ) ; 
for i := 1 to 6 do 

For j := 1 to 6 do 

COVAROUTF i , j 1 := ZERO ; 
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try 

SIXTUC := SIXTUC_MATRIX< SIXPOPINtpopulationl ) s 
for n := 1 to NUMVALS do 
begin 

if ( n nod 100 ) = 0 then 
begin 
L : = * ’ 5 

strurite ( L, 1 ,M, ’GAUSSIAN_RANDOM_SIXVECTOR \n:5 ) ; 
CLEAR_LINE ; 

SHOW ( L ) 5 
end s 

V :=* G AUS S I AN_RANDOM_S I X VECTORt SIXTUC ) j 
for i := 1 to 6 do 

for j := 1 to 6 do 

COVAROUTt i , j ] :•= COVAROUTt i , j ] + V[ i ] * VC j ] 5 

end ; 

SHOULN ( ’ ’ ) ; 

RESTORE_CURSQR ; 

uiriteln ( LP, ’ SIXPOPOUT =’:ZZ, 

’ statistical summary of ’ ,NUMVALS:4, 

’ pseudorandom’ ) ; 

uriteln ( LP, ’’:ZZ,’ six-vectors from population defined by’ , 

’ SIXP OPIN’ ) 5 

for h := 1 to Z do uriteln ( LP ) ; 
for i :* 1 to 6 do 

for j :*= I to 6 do 

COVAROUTt i,j] := COVAROUTt i ,j 1 / NUMVALS ; 
for j := 1 to 6 do 
begin 

jj := TRIANG_INDEX< j, j ) 5 
SIXPOPOUT! jj] :•= sqrtt COVAROUTt j ,j J ) ; 
end j 

for j := 1 to 5 do 
begin 

jj := TRIANG_.INDEX( j, j ) ; 
for i := j+1 to 6 do 
begin 

ii := TRIANG__INDEX< i, i ) ; 
ij := TRIANG_INDEX< i, j ) 5 
SIXPOPOUTtijl := COVAROUTt i ,j 1 / 

( SIXPOPOUTt iil *SIXPOPOUTf j j 1 ) ; 

end i 

end 5 

PRINT_FIXED_SIXPOP ( ’SIXPOPOUT =’ .SIXPOPOUT ) ? 
recover 

uriteln ( LP, ’escapecode = ' .escape code: 1 ) ; 

START_NEW_PAGE 5 
end ; 

end s -C procedure TEST_UTILSTAT_GAUSSIAN„RANOOM_SIXVECTOR._FUNCTION > 

< end File ’Teststat. I’ } 
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TEST_UTILMATH..MOOULE 


INK - 

-2.3 

) 

s= 

-3 

INK - 

-2.0 

) 

= 

-2 

INK - 

■0.3 

) 

- 

-1 

INK 

0.0 

) 

=3 

0 

INK 

1.3 

) 

S3 

1 

FRAC< - 

2.3 

) 

s 

0.70 

FRAC( - 

•2.0 

) 

ss 

0.00 

FRAC< - 

■0.3 

) 

s= 

0.70 

FRAC( 

0.0 

) 

= 

0.00 

FRAC( 

1.3 

) 

ss 

0.30 

RM0D( -Z.8, - 

■0.5 

) 

S3 

-0.30 

RMOD( -2.8, 

0.0 

) 

3 3 

0.00 

RMODC -2.8, 

0.5 

) 

= 

0.20 

RM0D( 2.8,- 

0.5 

) 

33 

-0.20 

RMOD( 2.8, 

0.0 

) 

=3 

0.00 

RM0D< 2.8, 

0.5 

) 

= 

0.30 

RSIGN( - 

1.9 

) 

3= 

-1 

RSI6N( 

0.0 

) 

=3 

1 

RSI6N< 

1.9 

) 

33 

1 

ISIGN( 

-5 

) 

S3 

-1 

ISIGNI 

0 

) 

3= 

1 

ISIGN1 

5 

) 

= 

1 

IMAX( -3, 

-4 

) 

S3 

-3 

IMAX( 3, 

4 

) 

S3 

4 

IMIN( -3, 

-4 

) 

S3 

-4 

IMIN( 3, 

4 

) 

33 

3 

RMAX< -Z.9, - 

3.9 

) 

33 

-2.90 

RMAX< 2.9, 

3.9 

) 

= 

3.90 

RMIN( -2.9, - 

3.9 

> 

33 

-3.90 

RMINI 2.9, 

3.9 

) 

3= 

2.90 
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flNGDEG( ONE ) = 
ANGRflD<ANGDEG<ONE>>-ONE = 

ANGOEG< ANG1 ( -THREE«TWQPI-HAFPI ) ) = 
ANGDEG( ANGZ( THREE*TUOPI-HAFPI ) ) = 

ANGDEG( ATAN1(-SIX,SIX)) « 
ANGDEG( ATAN2( -SIX, SIX) ) = 

HMS( -36385. 874L0 ) = 
HMS( 36385. 874L0 ) = 

SECS( - 1006. 25874L0 ) = 
SECS( 100G. 25874L0 ) = 

JULI AN_DAYNUM( 1980, 4, 2 ) = 


57.2957795130823 

-2.ZE-016 

270.000000000000 
-90. 000000000000 

315.000000000000 
- 45 . 000000000000 

-1006.258740 

1006.258740 

-36385.874000 

36385.874000 

2444332 
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TEST_UTILSPIF_MODULE 



"Sam Wilson" 
-29 

"Ben Wheeler" 
"N" 

254. 1 1 112000 


START_RANDOM_NUMBER_SEQUENCE ( 1 ) 


Pseudorandom integers: 


16807 
282475249 
1622650073 
984943658 
1 144108930 
470211272 
101027544 
1457850878 
1458777923 
2007237709 


START_RANDOM_NUMBER_SEQUENCE ( 2147483646 ) 


Pseudorandom integers: 


2147466840 
1865008398 
524833574 
1 162539989 
1003374717 
1677272375 
2046456103 
689632769 
688705724 
140245938 
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TEST_UTILVEMQ_MODULE 


V 

=s 

2 . 0000000000000 

-6.0000000000000 

u 

as 

4 . 0000000000000 

5.0000000000000 

DOTP< V , W) 

a 

-25. 0000000000000 


VMAG( V ) 

a 

7 • 0000000000000 


SXV(TUO.V) 

cs 

4.0000000000000 

-12.0000000000000 

CRSP( V , W ) 

- 

- 9 . 0000000000000 

1 4 . 0000000000000 

VDIF( V , U ) 

=s 

-2 .0000000000000 

-11. 0000000000000 

VSUM< V,U) 

a 

E . 0000000000000 

- 1 . 0000000000000 


D =* 

3 0.0000000000000 

1 0. 0000000000000 

VXD(V.D) = 

60. 0000000000000 

-60. 0000000000000 


M = 

1 . 0000000000000 

3. 0000000000000 


4 .0000000000000 

5 .0000000000000 


7 . 0000000000000 

8 . 0000000000000 

VXM(V,M) = 

- ! . 0000000000000 

0 . 0000000000000 

XMT(V,M) = 

1 1 . 0000000000000 

-4 .0000000000000 


3.0000000000000 
- 1 . 0000000000000 

6.0000000000000 

34.0000000000000 

4.0000000000000 

2.0000000000000 

40 . 0000000000000 

120.000000000000 

9 . 0000000000000 

6.0000000000000 

2 . 0000000000000 

- 12.0000000000000 

-28 .0000000000000 
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L = 


MDIF(L,M) - 


MSUM(L,M) - 


MXM( L,M) = 


MXMT(L,M) = 


MTXM(L.M) =• 


MINV(M) = 


N = MXM( M,MINV( M ) ) = 


MOIF( N, IDN3X3) - 


1 . 0000000000000 
- 2.0000000000000 

4 . 0000000000000 

0. 0000000000000 
- 6 . 0000000000000 
- 3 . 0000000000000 

2 . 0000000000000 
2 . 0000000000000 

1 1 . 0000000000000 

-12. 0000000000000 
60. 0000000000000 
-1Z. 0000000000000 

- 20.0000000000000 

67.0000000000000 
-23. 0000000000000 

21.0000000000000 
43.0000000000000 
-7 . 0000000000000 

-1.0270270270270 
0.9189189189189 
-0.0 81081081081 1 

1 . 0000000000000 
0 . 0000000000000 
0.0000000000000 

-3.3E-01G 
1 . 1 1E-016 
Z.78E-017 


2 . 0000000000000 

5.0000000000000 

3 . 0000000000000 

- 1 . 0000000000000 
0 . 0000000000000 
- 5 . 0000000000000 

5.0000000000000 
1 0 . 0000000000000 
1 1 . 0000000000000 

-11. 0000000000000 

67 . 0000000000000 
- 5 . 0000000000000 

-4 . 0000000000000 

53.0000000000000 

7.0000000000000 

25.0000000000000 

55 . 0000000000000 
-11. 0000000000000 

1.7837837837838 

-1.6486486486486 

0.3513513513514 

0. 0000000000000 

1 . 0000000000000 
0. 0000000000000 

0. 00E+000 
4. 44E-01 6 
-7.8E-0J6 


-3.0000000000000 

6.0000000000000 

-4.0000000000000 

- 12.0000000000000 

0.0000000000000 

- 6.0000000000000 

6.0000000000000 

12.0000000000000 

- 2.0000000000000 

1 5 . 0000000000000 

24.0000000000000 

46.0000000000000 

17.0000000000000 




44 . 0000000000000 

5.0000000000000 

54.0000000000000 

1 .0000000000000 

-0.7297297297297 

0.8108108108108 

-0.1891891891892 

0.0000000000000 
0 . 0000000000000 
1 .0000000000000 

0. 00E+000 
0.00E+000 
4.44E-016 


¥05806580 
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X = CRSP( W, V ) 

= 

9 . 0000000000000 

-14. 0000000000000 

-34 

NC 31 

s 

SXV< QNE/VMflG( X ), 

X ) 


Nil] 

- 

SXV< 0NE/VMftG< W ), 

U ) 


N[ 2 1 

ss 

CRSP( Nt 31 , N[ 1] ) 



N 

a 

0.6172133998484 

0.7715167498105 

-0 



0.7500152304084 

-0.5176735557710 

0 



0.2377493915935 

-0.3698323869232 

-0 

Q 

SS 

IMATQ( N ) 



Q.S 

ss 

0.2243743946150 



Q.V 

* 

0.8707828839414 

0.4368287457982 

0 

P 

■= 

QCXQ( Q, Q ) 



P.S 

= 

1 . 0000000000000 



P.V 

s 

0 . 0000000000000 

0. 0000000000000 

0 

ONE - P.S 

SS 

-2.2E-016 



P.V 

3= 

0. 00E+000 

0.00EH-000 


= MXMT( N, N ) 

3= 

1 . 0000000000000 

0 . 0000000000000 

0 



0 . 0000000000000 

1 . 0000000000000 

0, 



0 . 0000000000000 

0 . 0000000000000 

1 , 

MDIF( N, IDN3X3 ) 

» 

0. 00E+000 

0. 00E+000 




0. 00E*000 

0. 00E+000 




-2.8E-017 

0. 00E+000 



0000000000000 


1543033499621 

4116931427785 

8981643682420 


0239571893207 


0000000000000 


0.00E+000 

0000000000000 

0000000000000 

0000000000000 

-2.8E-017 

0.00E+000 

-2.2E-016 


¥FEFB919B 
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PRY 

22 

-145. 000000000000 

65 . 0000000000000 

- 1 70. 000000000000 




RPR 

2S 

10.0000000000000 

-15.0000000000000 

20. 0000000000000 




P 

22 

PRYQ( EULRAD( PRY ) 

) 





Q 

22 

RPRQ( EULRAD( RPR ) 

) 





P.S 

22 

0.5325855897693 






P.V 

— 

0.8153775734730 

0.0908499818748 

-0.2079862568553 




Q.S 

22 

0.9576621969425 






Q.V 

=2 

0.2566048122926 

-0.1300295006517 

0.0113761072310 

EULDEG( 

QPRY( 

P 

) ) 

= 

-145.000000000000 

65.0000000000000 

- 1 70. 000000000000 

EULDEG< 

QRPR( 

Q 

) > 

32 

-170. 000000000000 

1 5 . 0000000000000 

-160.000000000000 





PYR 

22 

80. 0000000000000 

- 35 . 0000000000000 

120. 000000000000 




YRY 

33 

- 5 . 0000000000000 

80.0000000000000 

-55 . 0000000000000 




P 

as 

PYRQ( EULRflD( PYR ) 

) 





Q 

as 

YRYQ( EULRftDI YRY ) 

) 





P.S 

as 

0.5326888026743 






P.V 

22 

0.5360641466904 

0. 1070262978581 

-0.6460829990840 




Q.S 

32 

0.6634139481689 






Q.V 

« 

0.5825634160696 

0.2716537822742 

-0.3830222215595 

EULOEG( 

QPYR( 

P 

) ) 

as 

80 . 0000000000000 

- 35 . 0000000000000 

120. 000000000000 

EULDEG( 

QYRY( 

Q 

) ) 

=3 

- 5 . 0000000000000 

80 . 0000000000000 

- 55 . 0000000000000 


¥5EB5D8 1 5 
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QMAT< 


ROT ( V 
IR0T( V 


R = 

QCXQ( P, Q ) 



S = 

0. 94ZZZZ78G49Z8 



V ■ 

-0. 1798Z48G34331 

0. Z447640Z78487 

0. 1413145773664 

R = 

QXQC( P, Q ) 



S = 

0. 94ZZZZ78G49Z8 



V = 

-0.0892 100165536 

0.0973556494454 

-0.3078630719675 

R = 

QXQ< P, Q ) 



S = 

-0. Z3543G4230378 



V = 

0. 800474880G090 

0.0446498281944 

-0. 54937787456G7 

) = 

0. 39Z380G875575 

-0. 1872049915819 

-0. 900S507687847 


0. 3301692551544 

-0.8851521670988 

0. 3Z786Z6298179 


-0. 358S01 9854Z73 

-0.425981 1406708 

-0. Z 855072 83Z 874 

N = 

MDIF( QMRT(R), MXM< QMRT(P) ,QMAT( Q) ) > 


N = 

1 . 1 1E-016 

1 .67E-016 

1 . 1 1E-016 


0. 00E+000 

0. 00E+000 

0.00E+000 


Z.Z2E-016 

1 .67E-01G 

-1 . IE-016 

) = 

-0. 1519683046476 

3. 1770527943276 

6. Z35G4Z 8037884 

) - 

-4. 08779GZ276343 

-3. 493533830564Z 

-4.4816451640041 

X = 

VDIF( V, IRQT( R0T( V 

,Q>,Q> > 


X «= 

0. 00E>000 

-1 .8E-015 

8. 88E-01 6 


¥3C35Efl95 


3 


1-8 



File ’UTILTEST.R’ Page 9 


Updated @ 08:26:03 Mon Z9 Sep 1986 


P.S = PI * R.S 
P.V = SXV( PI. R.V ) 

P.S = -0.7396453370029 

P. V - 2.5147660043043 0.1402715722396 -1.7259214947836 

Q - UNIQUAT< P ) 

Q. S = -0.2354364230378 

Q.V - 0.8004748806090 0.0446498281944 -0.5493778745667 


R = QXQC( Q, Q ) 


ONE - R.S 

R.V 


0. 00E+000 
0. 00E+000 


0.00E+000 


0.00E+000 


RPRPB = 


1 0 . 0000000000000 - 15. 0000000000000 


20. 0000000000000 


NERTENS P 


25 .0000000000000 
0. 0000000000000 
0. 0000000000000 


0 . 0000000000000 

40 . 0000000000000 
0.0000000000000 


0.0000000000000 
0 . 0000000000000 

55.0000000000000 


MPB 

NERTENS_.B 


QMAT< RPRQ( EULRAD1 RPRPB ))) 
MTXM( MPB,MXM( NERTENS_P , MPB)) 


NERTENS B = 


26.9793202303121 

3.1503479728235 

6.7143670304884 


3. 1503479728235 
43.4622804063605 
5.7320928450464 


6.7143670804884 

5.79Z09Z84504C4 

49.5583993633275 


S - NERTENS J3C 1,11, 

NERTENS_B[ 2,11, NERTENS_8t2 , 21 , 

NERTENS_BI3.il , NERTENS_B[ 3,21. NERTENS_Bt 3 , 31 


DIAGONALIZE ( S. 1.0L-8, 
E = 25.0000000000000 

RPROP - EULDEGI QRPR( IMATQ( 
RPRBP - -Z 0.0000000000000 


E, N ) 

40. 0000000000000 
N ) ) ) 

15.0000000000000 


55 . 0000000000000 


-9.9999999957838 


¥5EC086C0 
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¥68EDA54D 


TEST,..UTILSTAT_MODULE 


Test UNI FORM_RANDOM_SCALAR Function 


CUMULATIVE DISTRIBUTION OF 1000 PSEUDORANDOM NUMBERS 

FROM A 

UNIFORMLY DISTRIBUTED POPULATION 
HAVING ZERO MEAN 
< UNCERTAINTY = 5.0 > 


CLASS 

ACTUAL 

EXPECTED 

ACTUAL / 

UPPER BOUND 

DISTRIBUTION 

DISTRIBUTION 

EXPECTED 

-5.0 

0 

0 

1 . 0000 

-4.0 

103 

100 

1.0300 

-3.0 

215 

200 

1 . 0750 

-2.0 

328 

300 

1.0933 

-1.0 

412 

400 

1 .0300 

0.0 

513 

500 

1.0260 

1 .0 

602 

600 

1.0033 

2.0 

704 

700 

1.0057 

3.0 

809 

800 

1.0113 

4.0 

912 

900 

1.0133 

5.0 

1000 

1000 

1 . 0000 


3 . 1 - 1 <Z> 
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¥54E0C8E0 


Tost GAUSSIAN„RANDOM_SCAl.AR Function 


CUMULATIVE DISTRIBUTION OF 1000 PSEUDORANDOM NUMBERS 

FROM A 

NORMALLY DISTRIBUTED POPULATION 
HAVING ZERO MEAN 
< SIGMA = 10.0 ) 


CLASS 

ACTUAL 

EXPECTED 

ACTUAL / 

UPPER BOUND 

DISTRIBUTION 

DISTRIBUTION 

EXPECTED 

-Z5.0 

6 

6 

1 . 0000 

-Z0.0 

Z1 

Z3 

0.9130 

-15.0 

G3 

67 

0.9403 

-10.0 

14G 

159 

0.918Z 

-5.0 

Z98 

309 

0.9644 

0.0 

485 

500 

0.9700 

5.0 

687 

691 

0.S94Z 

10.0 

841 

841 

1 . 0000 

15.0 

937 

933 

1.0043 

Z0.0 

981 

977 

1.0041 

Z5.0 

994 

994 

1 . 0000 


3 . 1-1 1 
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Tost SIXTUC_MATRIX Function 


SIXPOPIN = 1.000 





0.487 

1.000 




0.535 

0.699 

1 .000 



-0.478 

-0.996 

-0.706 

1.000 


-0.199 

-0.66Z 

-0.6Z7 

0.667 

1.000 

-0.460 

-0.778 

-0.871 

0.789 

0.7Z0 

SIXPOPOUT * T * M . 

uhers M is 

SIXTUC. 

MATRIX* SIXPOPIN ) 


\ arid T is the transpose of M. 


1 .000 


SIXPOPOUT = 1.000 

0.487 

1.000 

0.535 

0.699 

-0.478 

-0.996 

-0.199 

-0.6BZ 

-0.460 

-0.778 

1 SIXPOPOUT-SIXPOPIN1 = 0.0E+000 

0. 0E-+000 

0 . 0Ei 000 

0.0E+000 

0.0E+000 

0. 0E-t000 

0.0E+000 

0. 0E i000 

0.0E>000 

0.0EH000 

0.0EI000 


1 .000 

-0.70B 1.000 

-0.BZ7 0.GB7 1.000 

-0.871 0. 789 0.7Z0 1.000 


0. 0O000 

0.0Ei000 0.0E+000 

0. 0E *000 0.0E+000 Z.ZE-016 

1. IE-016 1. IE-016 1. IE-016 0.0E+000 


¥88SB333B 
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Test GAUSSIflN_RANDOM_SIXVECTOR Function 


ASTP / Apollo STDN Z-Station Estimation Error 


SIXPOPIN = 75.301 





0.487 

179.906 




0.535 

0. 699 

79 . 855 



-0.478 

-0.996 

-0.706 

0.190 


-0.199 

-0.G6Z 

-0.6Z7 

0.667 

0. 114 

-0.4B0 

-0.778 

-0.871 

0.789 

0.7Z0 


SIXPOPOUT = 

statistical sumnary 

of 1000 

pseudorandom 


six-vectors from population 

def ined 

by SIXPOPIN 

SIXPOPOUT = 

76.6Z6 

0.504 183.598 

0.567 0.711 

-0.498 -0.996 

-0.ZZZ -0.671 

79.939 

-0.7Z0 

-0.640 

0.193 

0.677 

0.113 


-0.473 -0.787 

-0.875 

0.798 

0.7Z9 


¥6C5B573B 
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Test GAUSSIAN_RANDOM_SIXVECTOR Function 


PftIDS / Long-Range Stationkeep 

without 

TIC ; 0.5 

deg Deadbands 

SIXPOPIN = 10.100 





0.376 

40. 300 




-0.192 

0.165 

11.900 



-0.405 

-0.652 

-0.088 

0.063 


0.553 

-0.052 

-0.358 

0.068 

0.073 

-0.341 

0.274 

0. 187 

-0.208 

-0.361 0.026 

SIXPOPOUT = statistical 

summary 

of 1000 

pseudorandom 

six-vectors 

from popmlation 

defined by SIXPOPIN 

SIXPOPOUT = 10.162 





0.345 

38.759 




-0.201 

0.126 

11.897 



-0.398 

-0.607 

-0.025 

0.061 


0.576 

-0.019 

-0.345 

0.052 

0.072 

-0.414 

0.237 

0. 198 

-0, 141 

-0.389 0.026 


¥250C448C 
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Test GAU5SIAN_RflND0M_SIXVECT0R Function 


PflIDS / Long-Range Stationkeep with TIC ; 3.0 deg Deadbands 


SIXPOPIN - 6.900 





0.431 

Z7.800 




0.301 

0.098 

6.900 



-0.467 

-0. 360 

0.33Z 

0.04Z 


0.519 

0.515 

0.3Z9 

0. 104 

0.063 

-0.07Z 

0.056 

0.363 

0.068 

-0.015 


SIXPOPOUT - 

statistical 

summary 

of 1000 pseudorandom 


six- vectors 

from population 

defined by 

STXPOPIN 

SIXPOPOUT = 

6.884 

0.4ZZ 

Z7.85Z 





0.331 

0. 101 

6.9Z5 




-0.489 

-0.31 1 

0.Z86 

0.04Z 



0.5Z3 

0.544 

0.336 

0. 107 

0.063 


-0.04Z 

0.067 

0.41 1 

0, 10Z 

0.00Z 


0.0Z4 


0.0Z4 


¥ I DAD780D 
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Tests completed @ 08:26:01 Mon 29 Sep 1986 
CPU time * Z98.47 seconds 
Elapsed time = 298.52 seconds 


¥D5GG1 9A6 
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TEST_UTILMFITH_MODULE 




INK 

-2.3 

) 

a 

-3 


INK 

-2.0 

) 

a 

-2 


INK 

-0.3 

> 

a 

-1 


INK 

0.0 

) 

BX 

0 


INK 

1.3 

> 

a 

1 


FRAC( 

-2.3 

) 

EE 

0.70 


FRRC( 

-2.0 

> 

a 

0.00 


FRAC( 

-0.3 

) 

- 

0.70 


FRAC( 

0.0 

) 

a 

0.00 


FRAC( 

1.3 

) 

a 

0.30 

RM0D( 

-2.8. 

-0.5 

) 

a 

-0.30 

RM0D( 

-2.8. 

0.0 

) 

= 

0.00 

RMOD( 

-2.8. 

0.5 

) 

a 

0.20 

RMOD( 

2.8. 

-0.5 

> 

a 

-0.20 

RMOD( 

2.8. 

0.0 

) 

Si 

0.00 

RMOD( 

2.8. 

0.5 

) 

a 

0.30 


RSIGN( -1.9 ) = -1 

RSIGN( 0.0 ) = 1 

RSIGN( 1.8 > - 1 



ISIGN< -5 

) 

= 

-1 

ISIGN( 0 

) 

a 

1 

ISIGN( 5 

) 

a 

1 

IMAX< -3, -4 

) 

a 

-3 

IMAX( 3, 4 

) 

a 

4 

IMIN( -3, -4 

) 

a 

-4 

IMIN( 3, 4 

) 

a 

3 

RMAX( -2.9, -3.9 

> 

a 

-2.90 

RMAX< 2.9, 3.9 

) 

a 

3.90 

RMIN( -2.9, -3.9 

) 

a 

-3.90 

RMIN( 2.9, 3.9 

> 

a 

2.90 



¥ B5ADD00D 
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ANGDE6( ONE ) - 
ANGRAD( ANGDEG( ONE ) > -ONE = 

ANGOEG( ANG1 < -THREE*TWOPI-HAFPI ) ) - 
ANG0EG<ANG2< THREE*TUOPI-HAFPI ) ) = 

ANGDEG< ATAN1 ( -SIX, SIX) ) = 
ANGDEG( ATAN2( -SIX, SIX) ) = 

HMS< -36385. 874L0 ) = 
HMS( 36385. 874L0 ) = 

SECS( - 1006. 25874L0 ) = 
SECS( 1006. 25874L0 ) = 

JULIAN_DAYNUM( 1980, 4, 2 ) = 


57.29577951308232 

0.0L+00 

270. 000000000000 
-90. 000000000000 

315.000000000000 
-45.000000000000 

-1006.258740 

1006.258740 

-36385.874000 

36385.874000 

2444332 


¥41124352 
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TE5T_UTILSPI F_MODULE 


"San Wilson" 
-29 

"Ben Wheeler" 
"N" 

254. 1 1 112000 


START_RANDOM_NUMBER_SEQUENCE ( 1 > 


Pseudorandon integers: 


16807 
282475249 
1622650073 
984943658 
1 144108930 
4702 1 1 272 
101027544 
1457850878 
1458777923 
2007237709 


STflRT_RftNDOM_NUMBER_SEQUENCE ( 2147483646 ) 


Pseudorandon integers: 


2147466840 
1865008398 
524833574 
1 162539989 
1003374717 
1677272375 
2046456103 
689632769 
688705724 
140245938 



¥44759AD5 
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TEST_UTILVEMQ_MODULE 


V 

sa 

2 . 0000000000000 

- 6 . 0000000000000 

3 

u 

33 

4 . 0000000000000 

5 . 0000000000000 

-1 

D0TP( V , U) 

= 

-25. 0000000000000 



VMAG( V ) 

e= 

7 .0000000000000 



SXV( TWO , V ) 

= 

4.0000000000000 

-12.0000000000000 

6 

CRSP< V.W) 


- 9 . 0000000000000 

14.0000000000000 

34 

VQIF( V ,U) 

=3 

- z . 0000000000000 

-11.0000000000000 

4 

VSUM(V,U) 

S3 

6.0000000000000 

- 1 . 0000000000000 

2 


D = 

30 ■ 0000000000000 

1 0 . 0000000000000 

40 

VXD< V,D) « 

60.0000000000000 

-60.0000000000000 

120 


M = 

1 . 0000000000000 

3.0000000000000 

9 


4 . 0000000000000 

5.0000000000000 

6 


7 . 0000000000000 

8.0000000000000 

2 

VXM(V.d) = 

- 1 . 0000000000000 

0.0000000000000 

-12 

XMT(V.M) = 

1 1 . 0000000000000 

-4.0000000000000 

-28 


. 000000000000 ® 
. 0000000000000 

0000000000000 

0000000000000 

0000000000000 

0000000000000 

0000000000000 

0000000000000 

0000000000000 

0000000000000 

0000000000000 

0000000000000 

0000000000000 


¥CFB2 1 9F2 
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L = 

MDIF(L,M) = 
MSUM(L,M) = 
MXM(L.M) = 
MXMT(L,M) = 
MTXM( L,M) «* 
MINV(M) = 
N = MXM(M,MINV(M) ) = 
MDIF( N.IDN3X3) = 


1 . 0000000000000 
- Z . 0000000000000 

4.0000000000000 

0 . 0000000000000 
-6.0000000000000 
- 3 . 0000000000000 

2 . 0000000000000 

2 . 0000000000000 

1 1 .0000000000000 

- 1 Z . 0000000000000 

60 . 0000000000000 
- 12.0000000000000 

-20. 0000000000000 

67 . 0000000000000 
-23 .0000000000000 

2 1 . 0000000000000 

4 3 . 0000000000000 
-7.0000000000000 

-1 .0270270270270 
0.9189189189189 
-0.081081081081 1 

1 . 0000000000000 
0 . 0000000000000 
2. 77555756 15GL- 17 

-3.3L-1G 

1.1L-16 

Z.8L-17 


2 . 0000000000000 

5 . 0000000000000 

3 . 0000000000000 

- 1 . 0000000000000 
0.0000000000000 
-5.0000000000000 

5 . 0000000000000 

10.0000000000000 

1 1 . 0000000000000 

- 11.0000000000000 

67 . 0000000000000 
- 5 . 0000000000000 

-4.0000000000000 

53 . 0000000000000 

7 . 0000000000000 

25.0000000000000 

55.0000000000000 
- 11.0000000000000 

1.7837837837838 
- 1 . 6486486486486 
0.3513513513514 

0 . 0000000000000 

1 . 0000000000000 
-0. 0000000000000 

0.0L+00 

4.4L-16 

-7.8L-16 


- 3 . 0000000000000 
6.0000000000000 
- 4 . 0000000000000 

-12. 0000000000000 
0 . 0000000000000 
- 6.0000000000000 

6.0000000000000 

1 2 . 0000000000000 
-2.0000000000000 

15.0000000000000 

24.0000000000000 

46.0000000000000 

17.0000000000000 

38.0000000000000 

44 . 0000000000000 

5 . 0000000000000 

54 . 0000000000000 

1 . 0000000000000 

-0.7297297297297 
0.8108108108108 
-0. 1891891891892 

0.0000000000000 
0 . 0000000000000 

1 . 0000000000000 

0.0L+00 

0.0L+00 

4.4L-16 


¥AD722332 
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X - CRSPOJ.V) 


9 . 0000000000000 - 14. 0000000000000 - 34 . 0000000000000 


Nt 31 = SXV< QNE/VMAG( X ), X ) 
NM] = SXV< 0NE/VMAG( U ), W > 
N( 2 1 = CRSP( NC 31 , Nt 11 ) 


N 


0.6 172 133998484 
0.7500152304084 
0.2377493915935 


0.7715167498105 
-0.5176735557710 
-0. 3698323869232 


-0.1543033499621 
0.41 16931427785 
-0.8981643682420 


Q = IMATQ( N ) 


Q.S = 0. ZZ437439461 50 

Q.V = 0.8707828839414 0.4368287457982 0.0239571893207 


P « QCXQ( Q. Q > 


P.S = 
P.V = 



ONE - P.S = 


P.V = 


1 . 0000000000000 
0.0000000000000 

0. 0000000000000 

0 . 0000000000000 

-Z.ZL-16 

0.0L+00 

0.0L+00 

0.0L+00 


N - MXMT( N, N > = 


1 . 0000000000000 
5.551 1 1512313L-17 
5.551 1 151 Z313L- 17 


5.551 1 1 51Z31 3L- 17 

1 . 0000000000000 
5.551 1 1 51 231 3L- 17 


5.551 1 151Z313L-17 
5.551 1 151Z313L-17 

1 . 0000000000000 


MDIF( N. IDN3X3) = 

0.0L+00 

5.6L-17 

-5.6L-17 


5.6L-17 

0.0L+00 

5.6L-17 


-5.6L-17 

5.GL-17 

0.0L+00 


c- 


3 
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RPR = 

P = 
Q = 

P.S = 

P. V - 

Q. S = 
Q.V = 

EULDEG( QPRY( P ) ) = 
EULDEG< QRPR< Q > ) = 

PYR * 

YRY = 

P = 
Q = 

P.S = 

P. V = 

Q. S = 
Q.V « 

EULDEG< QPYR< P ) ) = 
EULDEGt QYRY< Q ) ) - 


-145. 0000000000000 

1 0 . 0000000000000 

PRYQ( EULRAD( PRY ) 
RPRQ( EULRAD( RPR ) 

0.53Z5855B97693 

0.8153775734730 

0. 95766Z 1 9694Z5 
0.Z5660481ZZ9ZG 

-145. 0000000000000 

- 1 70. 0000000000000 

80. 0000000000000 

- 5 . 0000000000000 

PYRQ( EULRAD( PYR ) 
YRYQ( EULRAD< YRY ) 

0. 53Z68880Z6743 
0.5360641466904 

0.6634139481689 
0.58Z5G34 160696 

80. 0000000000000 

- 5 . 0000000000000 


65.0000000000000 

-15.0000000000000 

> 

) 

0.0908499818748 

-0. 1300Z95006517 

65.0000000000000 

1 5 . 0000000000000 

- 35 . 0000000000000 

80. 0000000000000 

) 

> 

0. 1070Z6Z978581 

0. Z71 65378ZZ74Z 
- 35 . 0000000000000 
80 . 0000000000000 


- 1 70.0000000000000 
Z 0 . 0000000000000 

-0. Z07986Z568553 

0.01 1376107Z310 
-170. 0000000000000 
-160. 0000000000000 

1 Z0 . 0000000000000 
-55.0000000000000 

-0. 64608Z9990840 

-0.3830ZZZZ 15595 
1 Z0. 0000000000000 
- 55 . 0000000000000 
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ROT( V 
IROT( V 
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R - 

QCXQ( P, Q ) 



S - 

0. 94ZZ227864928 



V = 

-0. 1798Z48B34331 

0. Z 4476402784 87 

0. 1413145773664 

R = 

QXQC( P, Q ) 



S = 

0. 94ZZZZ78B49Z8 



V = 

-0.0892100165536 

0.0973556494454 

-0.3078630719675 

R - 

QXQ< P, Q ) 



S = 

-0.2354364230378 



V = 

0.8004748806090 

0.0446498281944 

-0.5493778745667 

) = 

0. 392 3806875575 

-0. 1872049915819 

-0.9005507687847 


0.3301692551544 

-0.8851521670988 

0.3278626298179 


-0.8585019854273 

-0.425981 1406708 

-0. Z85507Z83Z874 

N = 

MOIF< QMAT(R), MXM( QMAKP > ,QMftT( Q) ) ) 


N = 

5.6L-17 

-5.6L-17 

-1. 1L-16 


0.0L+00 

-Z.2L-16 

5.6L-17 


-1 . 1L-16 

-5.6L- 17 

-2.8L-I6 

) = 

-0.1518683046476 

3. 1770527943276 

6.2356428037884 

) - 

-4. 087796ZZ76343 

-3.4935338305642 

-4.4816451640041 

X = 

VDIF( V, IROT( R0T( V 

,Q> ,Q) ) 


X = 

4.4L-16 

0.0L+00 

0.0L+00 
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P.S - PI * R.S 
P.V = SXV< PI, R.V > 

P.S = -0.7396453370029 

P. V = Z. 5147660043043 0. 140Z71 57ZZ396 - 1 .7Z59Z 14947836 

Q = UNIQUAK P ) 

Q. S - -0. 2354364Z30378 

Q.V = 0.8004748806090 0.0446498Z81944 -0.5493778745667 

R = QXQC( Q. Q ) 


ONE - R.S = 

R.V = 


Z.ZL-1G 



0.0L+00 

0. 0L+00 

0.0L+00 


RPRPB = 


1 0 . 0000000000000 - 15. 0000000000000 


20 . 0000000000000 


NERTENS P 


Z 5 . 0000000000000 
0 . 0000000000000 
0 . 0000000000000 


0.0000000000000 
40 . 0000000000000 
0.0000000000000 


0.0000000000000 
0.0000000000000 
55 . 0000000000000 


MPB = QMAT( RPRQ( EULRAD( RPRPB )>) 
NERTENSJ3 = MTXMC MPB,MXM( NERTENS_P, MPB>) 


NERTENS_B = 


Z6. 9793Z0Z303 1 Z 1 
3. 1 5034797Z8Z35 
6.7143670804884 


3. 1503479728Z35 
43 . 46Z Z 804063605 
5. 79Z09Z 8450464 


6.7143670804884 
5. 79 Z09Z 8450464 
49 . 5583993633Z75 


S - NERTEN5_BI 1,11, 

NERTENS_B£Z.1 J , NERTENS_BI Z , Z 1 , 

NERTENS_Bf3.il, NERTENS_Bf 3,Z1 , NERTENS_Bf 3,31 


DIAGONALIZE < S, 1.0L-8, 
E * 25 .0000000000000 

RPRBP - EULDEGt QRPR< IMATQ( 
RPRBP = -Z0. 0000000000000 


E, N ) 

40 . 0000000000000 
N ) ) ) 

15.0000000000000 


55 . 0000000000000 


-9.9999999957838 
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Y68EDA54D 


TEST_UTILSTAT_MODULE 


Test UNI FORM_RANDOM_SC ALAR Function 


CUMULATIVE DISTRIBUTION OF 1000 PSEUDORANDOM NUMBERS 

FROM A 

UNIFORMLY DISTRIBUTED POPULATION 
HAVING ZERO MEAN 
( UNCERTAINTY = 5.0 ) 


CLASS 

ACTUAL 

EXPECTED 

ACTUAL / 

UPPER BOUND 

DISTRIBUTION 

DISTRIBUTION 

EXPECTED 

-5.0 

0 

0 

1 . 0000 

-4.0 

103 

100 

1.0300 

-3.0 

215 

200 

1.0750 

-2.0 

328 

300 

1.0933 

-1.0 

412 

400 

1.0300 

0.0 

513 

500 

1.0260 

1.0 

602 

600 

1 . 0033 

2.0 

704 

700 

1 . 0057 

3.0 

809 

800 

1.0113 

4.0 

912 

900 

1.0133 

5.0 

1000 

1000 

1 . 0000 
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¥54E0C8E0 


Test GAUSSI AN_RANDQM_SCALAR Function 


CUMULATIVE DISTRIBUTION OF 1000 PSEUDORANDOM NUMBERS 

FROM A 

NORMALLY DISTRIBUTED POPULATION 
HAVING ZERO MEAN 
( SIGMA - 10.0 ) 


CLASS 

ACTUAL 

EXPECTED 

ACTUAL / 

UPPER BOUND 

DISTRIBUTION 

DISTRIBUTION 

EXPECTED 

-25. 0 

6 

6 

1.0000 

-20. 0 

21 

23 

0.9130 

-15.0 

63 

67 

0.9403 

-10.0 

146 

159 

0.9182 

-5.0 

298 

309 

0.9644 

0.0 

485 

500 

0.9700 

5.0 

687 

691 

0.9942 

10.0 

841 

841 

1 . 0000 

15.0 

937 

933 

1.0043 

20.0 

981 

977 

1.0041 

25.0 

994 

994 

1 . 0000 
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Test SIXTUC_MflTRIX Function 


SIXPOPIN - 1.000 






0.487 

1 .000 





0.535 

0.699 

1.000 




-0.478 

-0.996 

-0.706 

1.000 



-0.199 

-0.66Z 

-0.6Z7 

0.667 

1 .000 


-0.460 

-0.778 

-0.871 

0.789 

0.7Z0 

1.000 

SIXPOPOUT - T * M , 

uhere M is SIXTUC. 

,MRTRIX( SIXPOPIN ) 



and T is 

the transpose of M, 



SIXPOPOUT = 1.000 






0.487 

1 .000 





0.535 

0.699 

i .000 




-0.478 

-0.996 

-0.706 

1.000 



-0. 199 

-0.66Z 

-0.6Z7 

0.667 

1 .000 


-0.460 

-0.778 

-0.871 

0.789 

0.7Z0 

1.000 

SIXPOPIN! - Z.ZL-16 






0.0L+00 

0.0L+00 





0. 0L+00 

0.0L+00 

1 . 1L-16 




0.0L+00 

0.0L+00 

0. 0L+00 

0.0L+00 



0. 0L+00 

0.0L+00 

0.0L+00 

0.0L+00 

0.0L+00 


0.0L+00 

0.0L+00 

0.0L+00 

0. 0L+00 

1 . 1 L- 1 6 

0. 0L+00 
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Test GAUSSIAN_RANDOM_SIXVECTOR Function 


ASTP / Apollo STDN 2-Station Estimation Error 


SIXPOPIN = 75.301 

0.487 179.906 

0.535 0.699 79.855 

-0.478 -0.996 -0.706 0.190 

-0.199 -0.662 -0.627 0.667 0.114 

-0.460 -0.778 -0.871 0.789 0.720 0.417 


SIXPOPOUT = statistical summary of 1000 pseudorandom 

six-vectors from population defined by SIXPOPIN 


SIXPOPOUT = 



76.626 




0.504 

183.598 



0.567 

0.71 1 

79.939 


-0.498 

-0.996 

-0.720 

0.193 

-0.222 

-0.671 

-0.640 

0.677 

-0.473 

-0.787 

-0.875 

0.798 


0.113 

0.729 0.415 
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Test GAUSSI AN_RANDOM_SI XVECTOR Function 


PAIDS / Long-Range Stationkeep without TIC ; 0.5 deg Deadbands 


SIXPOPIN = 10.100 





0.376 

40. 300 




-0. 19Z 

0. 165 

1 1 . 900 



-0.405 

-0.65Z 

-0.088 

0.063 


0.553 

-0.05Z 

-0.358 

0.068 

0.073 

-0.341 

0.Z74 

0. 187 

-0.Z08 

-0.361 


SIXPOPOUT = 

statistical 

summary 

of 1000 pseudorandom 


six-vectors 

from population 

defined 

by SIXPOPIN 

SIXPOPOUT = 

10. 16Z 






0.345 

38.759 





-0.Z01 

0. 1Z6 

11.897 




-0.398 

-0.607 

-0.0Z5 

0.061 



0.576 

-0.019 

-0. 345 

0.05Z 

0.07Z 


-0.414 

0.Z37 

0. 198 

-0. 141 

-0.389 
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Test GAUSSI AN_RANDOM_SI XVECTOR Function 


PAIDS / Long-Range Stationkeep 

with TIC 

; 3.0 deg 

Deadbands 

SIXPOPIN = 6.900 





0.431 

27.800 




0.301 

0.098 

6.900 



-0.467 

-0.360 

0.332 

0.042 


0.519 

0.515 

0.329 

0. 104 

0.063 

-0.072 

0.056 

0.363 

0.068 

-0.015 

SIXPOPOUT = statistical 

sunnary 

of 1000 pseudorandon 

six-vectors 

fron population 

defined by 

SIXPOPIN 

SIXPOPOUT = 6.884 





0.422 

27.852 




0.331 

0. 101 

6.925 



-0.489 

-0.31 1 

0.286 

0.042 


0.523 

0.544 

0.336 

0. 107 

0.063 

-0.042 

0.067 

0.41 1 

0. 102 

0.002 


.024 


.024 
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Tests completed @ 14:54:32 Mon 29 Sep 1986 
CPU time = 71.65 seconds 
Elapsed time = 217.95 seconds 
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